perm filename PARSER.SAI[OK,TES] blob
sn#119643 filedate 1974-09-06 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00032 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00004 00002 ENTRY MANUSCRIPT
C00009 00003 INTERNAL STRING SIMPLE PROCEDURE RD(INTEGER BRKTBL)
C00016 00004 INTERNAL SIMPLE PROCEDURE RDENTITY
C00019 00005 ELSE
C00021 00006 INTEGER SIMPLE PROCEDURE ESTIMATE
C00023 00007 INTERNAL STRING SIMPLE PROCEDURE EVALV(STRING THISWD INTEGER IX, TYP)
C00028 00008 RECURSIVE PROCEDURE APPLYTOARGUMENTS(BOOLEAN DO!IT, PROCALL)
C00033 00009 INTERNAL RECURSIVE STRING PROCEDURE PASS comment Value is always NULL
C00038 00010 INTERNAL RECURSIVE STRING PROCEDURE E(STRING DEFAULT, STOPWORD)
C00042 00011 COMMENT Multiple Unary operators ( + , - , ABS , LENGTH , XLENGTH , and ↑ ) are combined
C00050 00012 WHILE THISTYPE=-BROKQ DO ie Substring Specifications
C00055 00013 SIMPLE PROCEDURE WARNLONG(STRING SEGM, MESG)
C00062 00014 RECURSIVE PROCEDURE PARAMS(INTEGER MOST STRING ARRAY PRE,PAR,POST)
C00065 00015 SIMPLE PROCEDURE FINPORTION
C00075 00016 SIMPLE PROCEDURE DBELOW
C00082 00017 RECURSIVE PROCEDURE DCONDITIONAL
C00089 00018 INTERNAL SIMPLE PROCEDURE SWITCHFONT(INTEGER WHICH)
C00093 00019 RECURSIVE PROCEDURE DFRAME(BOOLEAN BOXFRM)
C00095 00020 SIMPLE PROCEDURE DINSERT
C00098 00021 SIMPLE PROCEDURE DLOCAL
C00101 00022 SIMPLE PROCEDURE DMARGINS(BOOLEAN INWARD)
C00105 00023 SIMPLE PROCEDURE DPORTION
C00109 00024 SIMPLE PROCEDURE DRESPONSE(INTEGER COMDWD)
C00112 00025 CASE VARI-1 MIN 2 OF
C00115 00026 ie 3,4... AFTER/BEFORE area|unit
C00118 00027 RECURSIVE PROCEDURE DSKIP(BOOLEAN GRPSKIP)
C00122 00028 INTEGER SIMPLE PROCEDURE COUNTERSTMT
C00126 00029 RECURSIVE BOOLEAN PROCEDURE ASSIGNMENT
C00127 00030 RECURSIVE BOOLEAN PROCEDURE COMMAND
C00130 00031 ie NARROW DMARGINS(1) COMMENT SEMI-OBSOLETE
C00133 00032 INTERNAL RECURSIVE BOOLEAN PROCEDURE CHUNK(BOOLEAN VALID)
C00135 ENDMK
C⊗;
ENTRY MANUSCRIPT ;
BEGIN "PARSER"
DEFINE TERNAL = "EXTERNAL" , PRELOAD = "COMMENT" ;
REQUIRE "PUBDFS" SOURCE!FILE ;
REQUIRE "PUBMAI" SOURCE!FILE ;
BEGIN "INNER BLOCK"
REQUIRE "PUBINR" SOURCE!FILE ;
REQUIRE "PUBPRO" SOURCE!FILE ;
EXTERNAL INTEGER PROCEDURE XLENGTH(STRING S);
EXTERNAL RECURSIVE BOOLEAN PROCEDURE TEXTLINE ;
EXTERNAL RECURSIVE PROCEDURE DBREAK ;
EXTERNAL STRING SIMPLE PROCEDURE LABELREF(INTEGER USYMB, LEN) ;
FORWARD INTERNAL RECURSIVE BOOLEAN PROCEDURE CHUNK(BOOLEAN VALID) ;
FORWARD INTERNAL RECURSIVE STRING PROCEDURE E(STRING DEFAULT, STOPWORD) ;
FORWARD INTERNAL RECURSIVE STRING PROCEDURE PASS ;
EXTERNAL SIMPLE STRING PROCEDURE PICKFONT(INTEGER F) ;
IFC TENEX THENC
STRING PROCEDURE SCANTO(STRING BRKS; REFERENCE STRING SCANNEE; BOOLEAN INCLUDE) ;
BEGIN
INTEGER DUMMY ;
SETBREAK(LOCAL!TABLE, BRKS, NULL, IF INCLUDE THEN "IA" ELSE "IR") ;
RETURN(SCAN(SCANNEE, LOCAL!TABLE, DUMMY)) ;
END ;
STRING SIMPLE PROCEDURE CVFIL(STRING FILENAME; REFERENCE STRING EXT, PPN) ;
BEGIN
STRING NAME ;
PPN ← IF FILENAME[1 FOR 1] = "<" THEN SCANTO(">", FILENAME, TRUE) ELSE NULL ;
NAME ← SCANTO(".;", FILENAME, FALSE) ;
EXT ← IF FILENAME[1 FOR 1] = "." THEN SCANTO(";", FILENAME, FALSE) ELSE NULL ;
RETURN(NAME) ;
END ;
SIMPLE STRING PROCEDURE INCHWL ;
BEGIN
STRING S ; INTEGER C ;
S ← NULL ;
DO
BEGIN
C ← PBIN ;
IF C = CTLA THEN
IF NULSTR(S) OR EQU(S[∞-3 TO ∞], CRLF&"##") THEN
ELSE BEGIN
TES 8/23/74 ↑A ECHOES ANYWAY, SO FORGET PBOUT("\") ;
PBOUT(S[∞ FOR 1]) ;
S ← S[1 TO ∞-1] ;
END
ELSE IF C = CTLS THEN OUTSTR(" =" & EOL & "#" & S)
ELSE IF C = EOL OR C = ALTMODE THEN RETURN(S)
ELSE IF C = CTLV THEN S ← S & PBIN
ELSE IF C=RUBOUT THEN
BEGIN
OUTSTR(" XXX" & EOL & "#") ;
S ← NULL ;
END
ELSE IF C = LF THEN TES 8/23/74 ;
IF LAST<4 THEN RETURN(S)
ELSE BEGIN OUTSTR(CR&"##") ; S ← S & (CRLF&"##") END
ELSE IF C = CTLQ THEN TES 8/23/74 ;
BEGIN
OUTSTR("←"&CRLF&"#") ;
WHILE FULSTR(S) AND NOT EQU(S[∞-3 TO ∞],CRLF&"##") DO S←S[1 TO ∞-1] ;
IF FULSTR(S) THEN OUTSTR("#") ;
END
ELSE S ← S & C ;
END UNTIL FALSE ;
END "INCHWL" ;
ENDC
SIMPLE STRING PROCEDURE SUBST(STRING STR, OLDS, NEWFIRST, NEWREST) ;
BEGIN TES 8/23/74 FOR PUB!DEBUG AT LEAST ;
INTEGER WHICH ; TES 8/23/74 ;
STRING S ;
S ← NULL ; WHICH ← 0 ;
WHILE FULSTR(STR) DO
IF EQU(STR[1 TO LENGTH(OLDS)], OLDS) THEN
BEGIN
S ← S & (IF (WHICH←WHICH+1)=1 THEN NEWFIRST ELSE NEWREST) ;
STR ← STR[LENGTH(OLDS)+1 TO ∞] ;
END
ELSE S ← S & LOP(STR) ;
RETURN(S) ;
END "SUBST" ;
INTERNAL STRING SIMPLE PROCEDURE RD(INTEGER BRKTBL) ;
BEGIN
COMMENT INPUTSTR = [ [chars] LF line-no TB ]... [chars]
All break tables should break on LF.
RD's value is as if LF line-no TB were null. ;
INTEGER PTR, BYTEWD ; STRING SPTR, RESULT, PART ;
RESULT ← NULL ;
DO BEGIN "PARTIAL"
PART ← SCAN(INPUTSTR, BRKTBL, BRC) ;
IF BRC = LF THEN
BEGIN "MACRO LINE NUMBER"
MACLINE ← SCAN(INPUTSTR, TO!TB!FF!SKIP, DUMMY) ;
IF PART[∞ FOR 1] = LF THEN comment he Appended the break character ;
PART ← IF DEFINING THEN PART & MACLINE & TB ELSE PART[1 TO ∞-1]
ELSE IF DEFINING THEN PART ← PART & LF & MACLINE & TB ;
END "MACRO LINE NUMBER"
ELSE IF BRC = 0 THEN comment, ran out of input ;
IF INPUTCHAN < 0 THEN INPUTSTR ← SWICHBACK comment, done scanning macro body ;
ELSE BEGIN "FROM FILE"
DO BEGIN comment, may be page marks or eof or more lines ;
IF TECOFILE THEN
BEGIN COMMENT CHECK FOR FF AND SUPERFLUOUS LFs ;
SRCLINE ← CVS(CVD(SRCLINE)+1) ;
INPUT(INPUTCHAN, NO!CHARS) ;
WHILE BRC = LF DO
BEGIN
INPUT(INPUTCHAN,ONE!CHAR) ;
INPUT(INPUTCHAN,NO!CHARS) ;
END ;
END
ELSE SRCLINE ← INPUT(INPUTCHAN, TO!TB!FF!SKIP) ;
IF BRC = FF THEN
BEGIN "PGMARK"
PAGEMARKS ← PAGEMARKS + 1 ;
IF TECOFILE THEN
BEGIN
INPUT(INPUTCHAN, ONE!CHAR) ;
SRCLINE ← "0" ;
END ;
WHILE INPGS ∧ LAST=4 ∧ BRC=FF ∧ PAGEMARKS>RH(INPG[INPGX]) DO
IF (INPGX←INPGX+1)>INPGS THEN BEGIN BRC←0 ; EOF←1 END
ELSE IF PAGEMARKS<(K←LH(INPG[INPGX])) THEN
DO BEGIN "SKIP PAGES"
DO INPUT(INPUTCHAN,TO!LF!TB!VT!SKIP)
UNTIL BRC≠TB;
IF BRC = LF THEN
DO BEGIN
SRCLINE←INPUT(INPUTCHAN,TO!TB!FF!SKIP);
IF BRC=FF THEN PAGEMARKS←PAGEMARKS+1 ;
END UNTIL BRC≠FF ;
END "SKIP PAGES"
UNTIL BRC≠TB ∨ PAGEMARKS ≥ K ;
IF ¬EOF THEN
BEGIN COMMENT COMPUTE AND DISPLAY PAGE NUMBER ;
SRCPAGE ← CVS(PAGEMARKS) ;
IF NOT PUBSTD THEN OUTSTR((
IF SWDBACK THEN SPS(LAST-3)
ELSE SP
)&SRCPAGE) ;
SWDBACK ← 0 ;
END ;
END "PGMARK" ;
END
UNTIL BRC ≠ FF ;
MACLINE ← NULL ;
IF FULSTR(LSTOP) ∧ EQU(ERRLINE&"/"&SRCPAGE, LSTOP) THEN
BEGIN
DARN(NULL,VS(THISWD)&VS(THATWD)&VS(INPUTSTR)&CRLF&
VS(OWL[1 TO OAKS])&CRLF&VI(POSN)&VI(BRC)&VI(BRKTBL)) ;
S ← INCHWL ; LSTOP←("0000"&SCAN(S,DIGITA,DUMMY))[∞-4 FOR 5]&S ;
END ;
IF EOF THEN INPUTSTR ← SWICHBACK comment, done scanning a SOURCE!FILE or gen-file;
ELSE BEGIN "FILE LINE"
DO BEGIN "EXPAND TABS"
INPUTSTR ← INPUTSTR & INPUT(INPUTCHAN,TO!LF!TB!VT!SKIP) ;
IF BRC=TB THEN INPUTSTR←INPUTSTR&
(IF PAGESCAN(LAST)≥0 THEN
IF TABTAB=0 THEN
SPS(8-LENGTH(INPUTSTR) MOD 8)
ELSE TABTAB
ELSE TB)
ELSE IF BRC=VT THEN
IF INPUTSTR[∞ FOR 1]=RCBRAK THEN INPUTSTR←INPUTSTR&VT
ELSE
BEGIN "GENVT" COMMENT MAYBE {PAGE!} IN GEN-FILE ;
SPTR ← INPUT(INPUTCHAN, TO!VT!SKIP) ;
IF (PTR ← CVD(SPTR)) ≥ TWO(14)
AND LDB(PLIGHTWD("BYTEWD←ITBL[PTR-TWO(14)]"))=2
THEN
BEGIN
BREAKSET(LOCAL!TABLE,ALTMODE,"IS");
BREAKSET(LOCAL!TABLE,NULL,"O");
S ← STBL[LDB(IXWD(BYTEWD))] ;
INPUTSTR ← INPUTSTR[1 TO ∞-6] &
SCAN(S,LOCAL!TABLE,DUMMY);
END
ELSE INPUTSTR ← INPUTSTR & VT & SPTR & VT ;
END "GENVT"
END "EXPAND TABS"
UNTIL BRC = LF ∨ BRC < 0 ∨ EOF ;
IF BRC≤0 THEN
BEGIN BRC ← LF ;
IF ¬EOF THEN
WARN("=","Garbaged manuscript "&ERRLINE&"/"&SRCPAGE)
END ;
IF DEFINING THEN PART ← PART & LF & SRCLINE & "/" & SRCPAGE & TB ;
END "FILE LINE" ;
END "FROM FILE" ;
IF BRC = LF THEN
IF DEFINING THEN BEGIN BRC←0 ; IF INPUTSTR=COMMAND!CHARACTER THEN
BEGIN PART ← PART & TB ; LOPP(INPUTSTR) ; END END
ELSE IF INPUTSTR = COMMAND!CHARACTER ∨ INPUTSTR = TB THEN
BEGIN
LOPP(INPUTSTR) ;
BRC ← 0 ; comment, keep scanning ;
END
ELSE INPUTSTR ← (BRC ← RCBRAK) & VT & INPUTSTR ;
IF BRC THEN RETURN(IF LENGTH(RESULT)=0 THEN PART
ELSE IF LENGTH(PART)=0 THEN RESULT
ELSE RESULT & PART)
ELSE IF LENGTH(RESULT)=0 THEN RESULT ← PART
ELSE RESULT ← RESULT & PART ;
END "PARTIAL"
UNTIL FALSE ;
END "RD" ;
INTERNAL SIMPLE PROCEDURE RDENTITY ;
BEGIN Comment Sets THATWD, THATTYPE, LIT!ENTITY, LIT!TRAIL ;
STRING SEGMENT, SOURCE ; BOOLEAN DUN, TEXTLN ; INTEGER CC, FAM ; LABEL RETRY ;
TEXTLN ← FALSE ; RETRY: IF CHARTBL[INPUTSTR] LAND TWO(6) THEN RD(TO!VISIBLE) ;
SOURCE ← INPUTSTR ;
FAM ← LDB(FAMILY(SOURCE)) ;
CASE FAM MIN QUOTEQ+1 OF
BEGIN COMMENT BY FAMILY ;
ie 0 ... Letter ;
BEGIN "BUILD ID"
CC ← LENGTH(SEGMENT ← SCAN(SOURCE, ALPHA, BRC)) ;
THATWD ← CAPITALIZE(SEGMENT);
THATTYPE ← 0 ;
END "BUILD ID" ;
ie 1 ... Digit ;
BEGIN "BUILD INTEGER"
CC ← LENGTH(THATWD ← "0" & SCAN(SOURCE, DIGITA, BRC)) - 1 ;
THATTYPE ← -1 ;
END "BUILD INTEGER" ;
ie 2 ... EMPTYQ ; IMPOSSIBLE("RDENTITY") ;
ie 3 ... Terminal ;
BEGIN "MAYBE TEXT"
IF LDB(SPECIES("THATWD ← LOP(SOURCE)")) = 0 THEN TEXTLN ← TRUE ;
CC ← 1 ; THATTYPE ← -TERQ ;
END "MAYBE TEXT" ;
ie 4 ... Quote ;
IF SOURCE = """" THEN
BEGIN "STRING CONSTANT"
DUN ← FALSE ; THATWD ← "7" ; LOPP(SOURCE) ; CC ← 1 ; ie skip " ;
DO BEGIN "TO NEXT QUOTE"
SEGMENT ← SCAN(SOURCE, TO!QUOTE!APPD, BRC) ;
CC ← CC + LENGTH(SEGMENT) ;
IF BRC ≠ """" THEN
BEGIN "ERROR"
THATWD ← THATWD & SEGMENT[1 TO ∞-1] ; DUN ← TRUE ;
WARN("=","Omitted Right Quote From: "&THATWD) ;
END "ERROR"
ELSE IF SOURCE = """" THEN
BEGIN "INTERNAL QUOTE"
THATWD ← THATWD & SEGMENT ;
LOPP(SOURCE) ; CC ← CC + 1 ; ie skip second " ;
END "INTERNAL QUOTE"
ELSE
BEGIN "END STRING"
THATWD ← THATWD & SEGMENT[1 TO ∞-1] ;
DUN ← TRUE ;
END "END STRING"
END "TO NEXT QUOTE"
UNTIL DUN ;
THATTYPE ← -1 ;
END "STRING CONSTANT"
ELSE
BEGIN "OCTAL CONSTANT"
LOPP(SOURCE) ; THATTYPE ← -1 ;
CC ← LENGTH(SEGMENT ← SCAN(SOURCE, DIGITA, BRC)) + 1 ;
THATWD ← "8" & (DUMMY←CVO(SEGMENT)) ; COMMENT a one-character string ;
IF NOT INPICHAR THEN TES 12/6/73 ;
IF DUMMY='0 ∨ '11≤DUMMY≤'15 ∨ DUMMY=ALTMODE ∨ DUMMY=RUBOUT THEN
BEGIN
WARN("ILL OCTAL",
"Illegal octal constant (represents illegal character) "&CVOS(DUMMY)) ;
THATWD ← "7" ;
END ;
END "OCTAL CONSTANT" ;
ie 5 ... Other ;
BEGIN "SINGLE CHARACTER"
THATTYPE ← -FAM ; CC ← 1 ; THATWD ← LOP(SOURCE) ;
IF FAM = MISCQ THEN CASE LDB(SPECIES(THATWD)) OF
BEGIN
[4] ie ∞ ; BEGIN THATTYPE ← 0 ; THATWD ← "!INF" END ;
[0] BEGIN "ILL CHAR"
WARN("=","Extraneous '" & CVOS(THATWD) & " in command line") ;
LOPP(INPUTSTR) ; GO TO RETRY ;
END "ILL CHAR" ;
[MISCMAX]
END ;
END "SINGLE CHARACTER" ;
END ; COMMENT BY FAMILY ;
LIT!ENTITY ← INPUTSTR[1 TO CC] ;
INPUTSTR ← SOURCE ;
LIT!TRAIL ← IF TEXTLN THEN NULL ELSE IF CHARTBL[INPUTSTR] LAND TWO(6) THEN RD(TO!VISIBLE) ELSE NULL ;
END "RDENTITY" ;
INTEGER SIMPLE PROCEDURE ESTIMATE ;
BEGIN
INTEGER TOT, LEFT ;
TOT ← LEFT ← IF AREAIXM ∧ 0≤STATUS≤2 THEN LINES ELSE LINECT(IXTEXT) ;
LEFT ← LEFT + XGENLINES; RKJ;
IF STATUS=1 THEN LEFT ← LEFT - (LINE + COVERED + PINE) ;
IF NOT NOPGPH THEN LEFT ← LEFT - ( 1+(ABOVEX MAX BRKABX)-(BELOWX MIN BRKBLX)+
(IF NOFILL THEN LEADNM ELSE IF FIRST THEN LEADFM ELSE SPREADM-1) ) ;
RETURN(IF LEFT<0 THEN -(LEFT+TOT) ELSE LEFT) ;
END "ESTIMATE" ;
INTEGER SIMPLE PROCEDURE EMPTYCOLS ;
IF COL = 0 THEN RETURN(COLS)
ELSE BEGIN
INTEGER COUNT, COLUMN ; COUNT ← 0 ;
FOR COLUMN ← (COL - 1) MOD COLS + 1 THRU COLS DO
IF AA[COLUMN, 0] = 0 ∧ AA[COLUMN+COLS,0] = 0 THEN COUNT ← COUNT + 1 ;
RETURN(COUNT-(IF ESTIMATE<0 THEN 1 ELSE 0)) ;
END "EMPTYCOLS" ;
STRING PROCEDURE TYPEIN ;
BEGIN
IF NOT ON THEN RETURN (NULL); RKJ: 5-10-74 ;
IF NOT SWDBACK THEN OUTSTR(CRLF) ; SWDBACK ← TRUE ;
OUTSTR("#") ;
RETURN(INCHWL) ;
END "TYPEIN" ;
INTERNAL STRING SIMPLE PROCEDURE EVALV(STRING THISWD ; INTEGER IX, TYP) ;
BEGIN comment, evaluates the "variable" in THISWD ;
CASE TYP OF
BEGIN COMMENT BY TYPE ;
[0] BEGIN IF ON THEN WARN("=","Undefined Identifier " & THISWD) ; RETURN(VIRGIN) END ;
[GLOBALTYPE] RETURN(STBL[IX]) ;
[LOCALTYPE] RETURN(SSTK[IX]) ;
[INTERNTYPE]
BEGIN "INTERNAL"
RETURN(CASE IX OF (
ie 0 ... LINES ; CVS(ABS(ESTIMATE)),
ie 1 ... COLUMNS; CVS(CASE STATUS+1 OF (
ie -1 ... no place area ; 0,
ie 0 ... unopened area ; COLS-(IF ESTIMATE<0 THEN 1 ELSE 0),
ie 1 ... open area ; EMPTYCOLS,
ie 2 ... closed area ; 0,
ie 3 ... dis-declared ; 0) ),
ie 2 ... ! ; !,
ie 3 ... SPREAD ; CVS(SPREADM),
ie 4 ... FILLING; IF ¬FILL THEN "0" ELSE IF ADJUST THEN "1" ELSE "-1",
ie 5 ... !SKIP! ; CVS(MANUS!SKIP!),
ie 6 ... !SKIPL!; CVS(LH(MANUS!SKIP!)),
ie 7 ... !SKIPR!; CVS(RH(MANUS!SKIP!)),
ie 8 ... NULL ; NULL,
ie 9 ... ∞ ; CVS(INF),
ie 10... FOOTSEP; FOOTSEP,
ie 11... TRUE ; "-1",
ie 12... FALSE ; "0",
ie 13... INDENT1; CVS(FIRSTIM),
ie 14... INDENT2; CVS(RESTIM),
ie 15... INDENT3; CVS(RIGHTIM),
ie 16... LMARG ; CVS(LMARG),
ie 17... RMARG ; CVS(RMARG),
ie 18... CHAR ; IF NOPGPH THEN "0" ELSE CVS(POSN), TES 0->"0" 5/26/74;
ie 19... CHARS ; CVS(IF NOPGPH THEN RMARG-LMARG ELSE MAXIM-POSN),
ie 20... LINE ; CVS(IF STATUS=1 THEN LINE ELSE 0),
ie 21... COLUMN ; CVS(IF STATUS=1 THEN COL ELSE 0),
ie 22... TOPLINE; CVS(LINE1(IF AREAIXM THEN AREAIXM ELSE IXTEXT)),
ie 23... XCRIBL; CVS(XCRIBL),
ie 24... CHARW ; CVS(CHARW),
ie 25... XGENLINES; CVS(XGENLINES),
ie 26... UNDERLINE ; VUNDERLINE, TES 10/22/73 ;
ie 27... THISDEVICE ; TES 11/15/73 ;
CASE ABS(DEVICE)-1 OF ("LPT","TTY","MIC","XGP"),
ie 28... THISFONT ; IF THISFONT < 10 THEN
THISFONT+"0" ELSE THISFONT+("A"-10),
ie 29... FOOTGAP ; CVS(FOOTGAP), TES 11/27/73 ;
ie 30... FOOTSEPFONT ; PICKFONT(FSFONT)[3 FOR 1], TES 11/29/73 ;
ie 31... TTY ; TYPEIN, TES 11/29/73 ;
ie 32... ODDLEFTBORDER ; CVS(ODDLEFTBORDER), TES 6/11/74 ;
ie 33... EVENLEFTBORDER ; CVS(EVENLEFTBORDER), TES 6/11/74 ;
ie 34... FULLFILE ; INFILE, TES 6/13/74 ;
ie 35... THISLINE ; OWL[1 TO OAKS], TES 8/19/74 ;
ie 36... MAXTEMPLATE ; CVS(MAXTEMPLATE), TES 8/19/74 ;
ie 37... ERRLF ; CVS(ERRLF), TES 8/21/74 ;
ie 38... DEBUGFLAG ; CVS(DEBUGFLAG), TES 8/21/74 ;
ie 39... !XGPLFTMAR ; CVS((ODDLEFTBORDER*200)/1000), TES 9/4/74 ;
WARN(NULL,"PUB bug: EVALV CASE IX")
) ) ;
END "INTERNAL" ;
[MANTYPE] WARN("=",THISWD&" in an expression") ;
[PORTYPE] RETURN(THISWD) ;
[PUNITTYPE] RETURN(PATT!VAL("PATT!STRS(IX)")) ;
[AREATYPE] RETURN(THISWD) ;
[UNITTYPE] RETURN(CTR!VAL("PATT!STRS(IX)"))
END COMMENT BY TYPE ; ;
RETURN(NULL) ;
END "EVALV" ;
INTERNAL STRING SIMPLE PROCEDURE VEVAL ; RETURN(EVALV(THISWD, IX, THISTYPE)) ;
RECURSIVE PROCEDURE APPLYTOARGUMENTS(BOOLEAN DO!IT, PROCALL) ;
BEGIN TES 8/19/74 EXTRACTED FROM PASS TO HANDLE PROCEDURES AS WELL AS MACROS ;
BOOLEAN WASLPAR, DUMSEMI ;
INTEGER MACIX, MACSYM, ARGS, ARG, ARGSYM, NAMES, K ;
MACIX ← IX ; MACSYM ← SYMB ; ARGS ← NUMARGS(MACIX) ; DUMSEMI ← FALSE ;
IF ARGS THEN
BEGIN "SCAN ARGS"
STRING ARRAY ACTUAL[1:ARGS] ;
IF ¬(WASLPAR ← NEXTSCH("(")) THEN INPUTSTR ← LIT!ENTITY&LIT!TRAIL&INPUTSTR ;
comment , Back up. Pretend just passed comma. ; THISWD ← "," ; EMPTYTHAT ;
NAMES ← NAMEPAR(MACIX) ; comment bit table for name parameters ;
FOR ARG ← 1 THRU ARGS DO
BEGIN "EACH ACTUAL"
IF ¬ITSCH(",") THEN ACTUAL[ARG] ← NULL comment , omitted argument;
ELSE BEGIN RD(TO!VISIBLE) ;
IF NAMES LAND TWO(ARGS-ARG) = 0 THEN
BEGIN PASS ; ACTUAL[ARG] ← E(NULL, NULL&'0) ; END
ELSE BEGIN "CALL BY NAME"
IF BRC ≠ """" THEN
BEGIN comment , Unquoted Call-By-Name ;
IF (K←BRC)="|" THEN RD(ONE!CHAR) ;
ACTUAL[ARG]←RD(IF K="|" THEN TO!VBAR!SKIP
ELSE IF WASLPAR THEN TO!COMMA!RPAR ELSE TO!TERQ!CR) ;
IF BRC=CR ∧ ¬WASLPAR THEN
BEGIN comment force a semicolon ;
INPUTSTR ← ";" & INPUTSTR ;
DUMSEMI ← TRUE ;
END ;
PASS ;
END
ELSE BEGIN PASS ; ACTUAL[ARG]←E(NULL,0) END ;
END "CALL BY NAME"
END
END "EACH ACTUAL" ;
WHILE ITSCH(",") DO
BEGIN
WARN("=","Too Many Arguments to "&SYM[MACSYM]) ;
PASS ; E(NULL, 0) ;
END ;
IF ITSCH(")") ∧ WASLPAR THEN BEGIN comment Easy case; END
ELSE BEGIN
IF WASLPAR THEN WARN("=","Missed ) After Macro Call") ;
comment Back Up -- SWICH only saves THATWD ;
IF THATISFULL THEN comment Unlikely; INPUTSTR ← LIT!ENTITY&LIT!TRAIL&INPUTSTR ;
IF THISISFULL ∧ ¬DUMSEMI THEN BEGIN THATWD ← LIT!ENTITY ← THISWD ;
LIT!TRAIL ← IF THISTYPE<-1 THEN NULL ELSE SP ;
THATTYPE ← THISTYPE MIN 0 END ELSE EMPTYTHAT ;
END ;
IF PROCALL THEN SWICH("RETURN(NULL);;",-2-BLNMS,0) ; TES 8/20/74 ;
IF DO!IT THEN
BEGIN "STACK ARGUMENTS"
IF LAST + ARGS > SIZE THEN GROWNESTS ;
FOR ARG ← 1 THRU ARGS DO
SNEST[LAST + ARG] ← ACTUAL[ARG] ;
LAST ← LAST + ARGS ;
END "STACK ARGUMENTS" ;
END "SCAN ARGS" ;
IF PROCALL AND NOT ARGS THEN SWICH("RETURN(NULL);;",-2-BLNMS,0) ; TES 8/20/74 ;
IF DO!IT THEN SWICH(SSTK[BODY(MACIX)], -1, ARGS)
ELSE BEGIN THISWD ← "7" ; THISTYPE ← -1 END ; ie, Replace by NULL ("") ;
END "APPLYTOARGUMENTS" ;
RECURSIVE STRING PROCEDURE PROCSTATEMENT ;
IF THISTYPE = MACROTYPE THEN
IF ODDMAC(IX)<2 THEN WARN(NULL,"Unexpanded MACRO "&THISWD&" (PUB bug)")
ELSE IF ON THEN
BEGIN
INTEGER PR ;
PR←PROCEDURES←PROCEDURES+1;
APPLYTOARGUMENTS(TRUE, TRUE);
DO STATEMENT UNTIL PROCEDURES<PR;
RETURN(TRUE) ;
END
ELSE BEGIN
APPLYTOARGUMENTS(FALSE, FALSE) ;
RETURN(TRUE) ;
END
ELSE RETURN(FALSE) ;
INTERNAL RECURSIVE STRING PROCEDURE PASS ; comment Value is always NULL ;
BEGIN comment, Load up WD[0:1], TYPE[0:1], SYMB, and IX for the parser.
Calls CHUNK recursively! PASS will expand macro calls,
replace macro/response arguments with their actual values,
skip over comments, and execute asides.;
PRELOAD!WITH 0, [3]3, 2, [4]3, 0, 1, 0, 4, [5]0, 5, 0, 0, 6, [7]0, 7, 0 ;
OWN INTEGER ARRAY SCANTYPE[-15:15] ; comment, computes small case index ;
BOOLEAN FINAL ;
DO BEGIN "LOAD WD 0"
IF ¬THATISFULL THEN RDENTITY ;
THISWD ← THATWD ;
THISTYPE ← IF THATTYPE THEN THATTYPE comment, non-identifier ;
ELSE IF SYMLOOK(THATWD) THEN LDB(TYPEN(SYMBOL))
ELSE 0 ; comment, undeclared identifier ;
IF THISTYPE ≠ -TERQ THEN RDENTITY ;
IF THISISID THEN
BEGIN "IDENTIFIER"
SYMB ← SYMBOL ;
IF ¬DCLR!ID ∧ THATISID ∧ SYMLOOK(THISWD & SP & THATWD) THEN
BEGIN comment, two-word macro name ;
THISWD ← SYM[SYMB←SYMBOL] ; THISTYPE ← MACROTYPE ;
IX ← LDB(IXN(SYMBOL)) ; RDENTITY ;
END
ELSE BEGIN SYMBOL←SYMB ; IF NULSTR(SYM[SYMB]) THEN ENTERSYM(THISWD,0) ; IX←LDB(IXN(SYMB)) ;END ;
END "IDENTIFIER" ;
FINAL ← FALSE ;
DO CASE SCANTYPE[THISTYPE] OF
BEGIN COMMENT DETECT ;
ie 0 ... Nothing to do ; BEGIN END ;
ie 1 ... $ ; IF NEXTSCH("(") THEN
BEGIN EMPTYTHAT ; THISWD←"⊂" ;
IX ← LDB(SPECIES(THISWD)) ; THISTYPE ← -TERQ ;
END
ELSE IX←LDB(SPECIES(THISWD)) ; COMMENT REPLACED OLD "ASIDE" (UNPUBL. FEATURE) 2/20/73 ;
ie 2 ... < Family ; IF ITSCH(<) AND NEXTSCH(<) THEN
BEGIN "<<COMMENT>>" SETBREAK(LOCAL!TABLE, ">"&RCBRAK&LF, NULL, "IS") ;
DO RD(LOCAL!TABLE) UNTIL BRC=">" ∧ INPUTSTR=">" ∨ BRC=RCBRAK ∧ INPUTSTR=VT ;
IF BRC=">" THEN RD(ONE!CHAR)
ELSE BEGIN WARN("=","Unterminated <<comment>>") ; INPUTSTR←BRC&INPUTSTR END ;
EMPTYTHIS ; EMPTYTHAT ;
END "<<COMMENT>>"
ELSE IX ← LDB(SPECIES(THISWD)) ; ie relational operator ;
ie 3 ... Expression Operators ; IX ← LDB(SPECIES(THISWD)) ;
ie 4 ... Terminal ;
BEGIN
IF ITSCH("]") ∧ INPUTSTR="$" THEN
BEGIN LOPP(INPUTSTR) ; THISWD ← RCBRAK END ;
EMPTYTHAT ; IX ← LDB(SPECIES(THISWD)) ;
END ; Comment NOTE!! }),]⊂;
ie 5 ... internal variable ; IF ¬DCLR!ID ∧ IX ≥ 200 THEN
BEGIN "OPERATOR"
IX ← IX-200 ; comment e.g., NOT → ¬ ;
THISTYPE ← -LDB(FAMILY(IX)) ;
IX ← LDB(SPECIES(IX)) ;
END "OPERATOR" ;
ie 6 ... reserved word ; IF IX=IXCOMMENT∧ ¬DCLR!ID THEN
BEGIN "COMMENT"
INPUTSTR ← LIT!ENTITY & INPUTSTR ;
DO RD(TO!SEMI!SKIP) UNTIL BRC=";" ∨ INPUTSTR=VT ;
IF BRC ≠ ";" THEN BEGIN WARN("=","Unterminated COMMENT;") ; INPUTSTR←BRC&INPUTSTR END ;
EMPTYTHIS ; EMPTYTHAT ; ;
END "COMMENT" ;
ie 7 ... macro name ;
IF ¬DCLR!ID AND ODDMAC(IX)<2 THEN APPLYTOARGUMENTS(ON OR ODDMAC(IX), FALSE) ; TES 8/19/74 ;
END COMMENT DETECT ; UNTIL (FINAL ← ¬FINAL) ;
END "LOAD WD 0" UNTIL THISISFULL ;
RETURN(NULL) ;
END "PASS" ;
INTERNAL RECURSIVE STRING PROCEDURE E(STRING DEFAULT, STOPWORD) ;
COMMENT Scan a SAIL-Like <Expression>. First check trivial case. ;
IF ITS(IF) THEN
BEGIN "CONDITIONAL EXPRESSION"
STRING BOOLX, THENX, ELSEX ; BOOLEAN WASON ;
WASON ← ON ; PASS ;
BOOLX ← E(NULL, "THEN") ; ON ← WASON ∧ TRUESTR(BOOLX) ;
IF ITS(THEN) THEN PASS ELSE WARN("=","Missed THEN in conditional expression "&THISWD) ;
THENX ← E(NULL, "ELSE") ;
IF ITS(ELSE) THEN
BEGIN
ON ← WASON ∧ FALSTR(BOOLX) ; PASS ;
ELSEX ← E(NULL, STOPWORD) ;
END
ELSE ELSEX ← NULL ;
ON ← WASON ;
RETURN(IF TRUESTR(BOOLX) THEN THENX ELSE ELSEX) ;
END "CONDITIONAL EXPRESSION"
ELSE IF THISTYPE = -TERQ ∨ THISTYPE = MANTYPE ∨ ITSV(STOPWORD) THEN
RETURN(DEFAULT) comment omitted expression ;
ELSE IF THISTYPE ≥ -1 ∧ (THATTYPE = -TERQ ∨ THATTYPE=MANTYPE ∨ NEXTSV(STOPWORD)) THEN
RETURN(SPASS("IF THISISCON THEN THISWD[2 TO ∞] ELSE VEVAL"))
ELSE IF THISISID ∧ NEXTSCH(←) THEN comment, Assignment Expression ;
RETURN(VASSIGN(SYMB, THISTYPE, IX, E(IPASS(PASS), STOPWORD)))
ELSE
BEGIN "SIMPLE EXPRESSION"
STRING ANY, comment, result of A∨B∨...: has value of first TRUE operand;
ALL, comment, result of A∧B∧...: has value of first FALSE operand;
COMPARE, comment, result of A<B≤...: TRUE if all relations are TRUE;
LEFT, comment, preceding right comparator, saved for another comparison;
BOUNDARY, comment, result of A MAX B MIN... ;
PRODUCT, comment, result of * / MOD & ;
PRIMARY ; comment, <const>|<var>|( <expr> )|<unary><primary>|<primary><substr spec> ;
INTEGER OROP, comment, =0 signals ∨ waiting for right operand ;
ANDOP, NOTOP, comment, =0 signals ∧ or ¬ operator waiting ;
RELOP, ODDOP, BOUNDOP, ADDOP, MULOP, comment, ≥0 signals operator waiting ;
UNARYOP, comment, ≥0 signals unary operators waiting ;
U, comment, last of a series of unary operators ;
SS1, comment, starting byte number in substring spec ;
SAVEINF, comment, saved outside value of ∞ ;
SYMPTR, comment, symbol table number of identifier ;
IDTYPE, comment, type field in its NUMBER entry ;
ICOMPARE, ILEFT, IBOUNDARY, ISUM, IPRODUCT, IPRIMARY ; comment, CVD(corresponding string);
BOOLEAN WASONA, WASONO ; comment value of ON before a series of conjuncts or disjuncts ;
DEFINE TRYFAMILY(FAM) = "IF THISTYPE=-FAM THEN IPASS(IX)";
COMMENT Multiple Unary operators ( + , - , ABS , LENGTH , XLENGTH , and ↑ ) are combined
into a single operator by inventing new operators such as
"-ABS" and "ABS LENGTH" ;
DEFINE P = "0", comment, +X ; M = "1", comment, -X ; A = "2", comment, ABS X ;
MA = "3", comment, -ABS X ; C = "4", comment, ↑X ;
L = "5", comment, LENGTH(X) ; ML = "6", comment -LENGTH(X) ;
AL = "7", comment, ABS LENGTH(X) ; MAL = "8", comment, -ABS LENGTH(X) ;
Z = "9", comment, XLENGTH(X) ; MZ = "10", comment -XLENGTH(X) ;
AZ = "11", comment, ABS XLENGTH(X) ; MAZ = "12"; comment, -ABS XLENGTH(X) ; TES 8/14/74 ;
PRELOAD!WITH comment RIGHT OPERATOR
---------------------------------
LEFT OPERATOR + - ABS ↑ LENGTH XLENGTH
------------- --- --- --- --- -------- ---------
none; P, M, A, C, L, Z,
comment P ; P, M, A, P, L, Z,
comment M ; M, P, MA, M, ML, MZ,
comment A ; A, A, A, A, AL, AZ,
comment MA ; MA, MA, MA, MA, MAL, MAZ,
comment C ; P, M, A, C, L, Z ;
OWN INTEGER ARRAY COMBINE[-1:4,0:5] ;
COMMENT This is a top-down expression parser, but iteration is used
instead of recursion for rapidity ;
OROP ← ANDOP ← NOTOP ← RELOP ← BOUNDOP ← ADDOP ← MULOP ← -1 ;
WASONO ← ON ;
DO BEGIN "DISJUNCTS" ie Operands of ∨ ;
WASONA ← ON ;
DO BEGIN "CONJUNCTS" ie Operands of ∧ ;
WHILE THISTYPE = -NOTQ DO BEGIN NOTOP ← -1 - NOTOP ; PASS END ;
ICOMPARE ← TRUE ;
DO BEGIN "COMPARATORS" ie Operands of < = etc. ;
ODDOP ← TRYFAMILY(ODDQ) ELSE -1 ;
DO BEGIN "BOUNDS" ie Operands of MAX and MIN ;
DO BEGIN "TERMS" ie Operands of + - ≡ ⊗ ;
DO BEGIN "FACTORS" ie Operands of * / MOD & ;
UNARYOP ← -1 ; ie check for Unary Operators ;
WHILE UNARYOP≤3 ie no, P, M, A, or MA left operator ;
AND 0 ≤ (U ← TRYFAMILY(ADDQ) ELSE -1) ie some right operator ;
DO UNARYOP ← COMBINE[UNARYOP, U] ;
comment PRIMARY ;
IF THISISCON THEN BEGIN PRIMARY ← THISWD[2 TO ∞] ; PASS END
ELSE IF THISISID THEN
IF ITSV(STOPWORD) THEN
BEGIN
PRIMARY ← DEFAULT ;
WARN("=","Ill-Formed Expression" & THISWD) ;
END
ELSE IF PROCSTATEMENT THEN PRIMARY ← PROCVALUE
ELSE IF NEXTSCH("(") THEN
BEGIN "FUNCALL" TES 8/19/74 ;
IF ITS(DECLARATION) THEN
BEGIN
PASS ; PASS ;
PRIMARY ← CVS(THISTYPE) ; PASS ;
END
ELSE IF ITS(OCTAL) THEN
BEGIN
STRING T ;
PRIMARY ← NULL ; PASS ; PASS ; T ← E(NULL,NULL) ;
WHILE T DO PRIMARY ← PRIMARY & "'" & CVOS(LOP(T)) ;
END
ELSE IF ITS(BEWARE) THEN
BEGIN TES 8/21/74 INVERSE OCTAL ;
STRING T ; INTEGER BRC ;
PRIMARY ← NULL ; PASS ; PASS ; T ← E(NULL,NULL) ;
SETBREAK(LOCAL!TABLE,"'",NULL,"IS") ;
DO BEGIN
SCAN(T, LOCAL!TABLE, BRC) ;
IF BRC THEN PRIMARY ← PRIMARY & CVO(T) ;
END UNTIL NOT BRC ;
END
ELSE IF ITS(SCAN) THEN
BEGIN "SCANCALL"
BOOLEAN ISBRC ;
STRING STR, STOPPERS, IGNORES, OPTIONS ;
INTEGER SYMWAS, IXWAS, TYPEWAS, BRC ;
STOPPERS←IGNORES←OPTIONS←NULL ;
ISBRC ← FALSE ; PASS ; PASS ;
IF THISISID AND NEXTSCH(",") THEN
BEGIN COMMENT VARIABLE TO LOP ;
SYMWAS←SYMBOL; IXWAS←IX; TYPEWAS←THISTYPE;
STR ← VEVAL ; PASS ;
END
ELSE BEGIN COMMENT EXPRESSION ;
IXWAS ← -1 ;
STR ← E(NULL, NULL) ;
END ;
IF ITSCH(",") THEN
BEGIN COMMENT STOPPERS ;
PASS ; STOPPERS←E(NULL, NULL) ;
IF ITSCH(",") THEN
BEGIN COMMENT IGNORES ;
PASS ; IGNORES ← E(NULL,NULL) ;
IF ITSCH(",") THEN
BEGIN COMMENT OPTIONS ;
PASS ; OPTIONS ← E(NULL,NULL) ;
IF ITSCH(",") THEN
BEGIN COMMENT BRC VARIABLE ;
PASS ;
IF THISISID AND NEXTSCH(")") THEN
ISBRC←TRUE
ELSE WARN(NULL, "SCAN's BRC must be variable name") ;
END ;
END ;
END ;
END ;
SETBREAK(LOCAL!TABLE, STOPPERS, IGNORES,
IF FULSTR(OPTIONS) THEN OPTIONS ELSE "IR") ;
PRIMARY ← SCAN(STR, LOCAL!TABLE, BRC) ;
IF ISBRC THEN
BEGIN
VASSIGN(SYMBOL, THISTYPE, IX, IF BRC=0 THEN NULL ELSE BRC) ;
PASS ;
END ;
IF IXWAS NEQ -1 THEN VASSIGN(SYMWAS, TYPEWAS, IXWAS, STR) ;
END "SCANCALL"
ELSE BEGIN
WARN(NULL,"Unknown function " & THISWD) ;
PASS ; PASS ; PRIMARY ← DEFAULT ;
WHILE NOT ITSCH(")") DO
IF ITSCH(",") THEN PASS
ELSE E(NULL,NULL) ;
END ;
IF ITSCH(")") THEN PASS
ELSE WARN(NULL, "Missing ) after function call") ;
END "FUNCALL"
ELSE BEGIN PRIMARY ← VEVAL ; PASS END
ELSE IF ITSCH("(") THEN
BEGIN "( <EXPR> )"
PASS ; PRIMARY ← E(DEFAULT, 0) ;
IF ITSCH(")") THEN PASS ELSE WARN("=","Missed )") ;
END "( <EXPR> )"
ELSE BEGIN WARN("=","Ill-Formed expression" & THISWD) ; PRIMARY ← DEFAULT END ;
WHILE THISTYPE=-BROKQ DO ie Substring Specifications ;
BEGIN "SUBSPEC"
PASS ; SAVEINF ← INF ; INF ← LENGTH(PRIMARY) ;
SS1 ← CVD(E("1", IF NEXTS(TO) THEN "TO" ELSE "FOR")) ;
IF ITS(TO) THEN BEGIN PASS ; PRIMARY←PRIMARY[SS1 TO CVD(E("0",0))] END
ELSE IF ITS(FOR) THEN BEGIN PASS ; PRIMARY←PRIMARY[SS1 FOR CVD(E("1",0))] END
ELSE PRIMARY ← PRIMARY[SS1 FOR 1] ;
MANUS!SKIP! ← !SKIP! ;
IF ITSCH(]) THEN PASS ELSE WARN("=","Missed ] in substring spec " & THISWD) ;
INF ← SAVEINF ;
END "SUBSPEC" ;
IF UNARYOP≤3 THEN ie both int & str versions maintained when needed ;
IPRIMARY ← IF PRIMARY="'" THEN CVO(PRIMARY[2 TO ∞]) TES 8/19/74 ;
ELSE CVD(PRIMARY) ;
IF UNARYOP ≥ 0 THEN IF UNARYOP=C THEN IPRIMARY←CVD(PRIMARY←CAPITALIZE(PRIMARY))
ELSE PRIMARY ← CVS(IPRIMARY ← CASE UNARYOP OF (IPRIMARY, -IPRIMARY,
ABS IPRIMARY, -ABS IPRIMARY, 0, LENGTH(PRIMARY), -LENGTH(PRIMARY),
ABS LENGTH(PRIMARY), -ABS LENGTH(PRIMARY),
XLENGTH(PRIMARY), -XLENGTH(PRIMARY),
ABS XLENGTH(PRIMARY), -ABS XLENGTH(PRIMARY) ) ) ; TES 8/14/74;
IF MULOP<0 THEN BEGIN PRODUCT ← PRIMARY ; IPRODUCT ← IPRIMARY END
ELSE IF MULOP = 3 THEN IPRODUCT ← CVD(PRODUCT ← PRODUCT & PRIMARY)
ELSE PRODUCT ← CVS(IPRODUCT ← IF IPRIMARY=0 ∨ ¬ON THEN 0 ELSE CASE MULOP OF
(IPRODUCT*IPRIMARY, IPRODUCT DIV IPRIMARY, IPRODUCT MOD IPRIMARY) ) ;
MULOP ← TRYFAMILY(MULQ) ELSE -1 ;
END "FACTORS" UNTIL MULOP < 0 ;
ISUM ← CASE ADDOP+2 OF (IPRODUCT, IPRODUCT, ISUM + IPRODUCT,
ISUM - IPRODUCT, ISUM ≡ IPRODUCT, ISUM ⊗ IPRODUCT) ;
ADDOP ← TRYFAMILY(ADDQ) ELSE IF ADDOP<0 THEN -1 ELSE -2 ;
END "TERMS" UNTIL ADDOP < 0 ;
IBOUNDARY ← CASE BOUNDOP+2 OF (ISUM, ISUM, IBOUNDARY MAX ISUM, IBOUNDARY MIN ISUM) ;
BOUNDOP ← TRYFAMILY(BOUNDQ) ELSE IF ADDOP=-1 ∧ BOUNDOP<0 THEN -1 ELSE -2 ;
END "BOUNDS" UNTIL BOUNDOP < 0 ;
BOUNDARY ← IF BOUNDOP = -1 THEN PRODUCT ie, hasn't changed since then; ELSE CVS(IBOUNDARY) ;
IF ODDOP≥0 THEN BOUNDARY←CVS(IBOUNDARY←(IBOUNDARY MOD 2)=ODDOP);
IF ICOMPARE THEN CASE RELOP+2 OF BEGIN comment SAIL Bug precludes case expression with relationals;
BEGIN END ; BEGIN END ; ICOMPARE←ILEFT<IBOUNDARY; ICOMPARE←ILEFT>IBOUNDARY; ICOMPARE ←
EQU(LEFT,BOUNDARY); ICOMPARE←ILEFT≤IBOUNDARY; ICOMPARE←ILEFT≥IBOUNDARY;
ICOMPARE←¬EQU(LEFT,BOUNDARY) END ;
RELOP ← TRYFAMILY(RELQ) ELSE IF RELOP < 0 THEN -1 ELSE -2 ;
LEFT ← BOUNDARY ; ILEFT ← IBOUNDARY ;
END "COMPARATORS" UNTIL RELOP < 0 ;
COMPARE ← IF RELOP=-1 THEN BOUNDARY ELSE CVS(ICOMPARE) ;
IF NOTOP = 0 THEN COMPARE ← IF TRUESTR(COMPARE) THEN "0" ELSE "-1" ;
NOTOP ← -1 ;
IF ANDOP < 0 OR TRUESTR(ALL) THEN IF FALSTR(ALL ← COMPARE) THEN ON ← FALSE ;
ANDOP ← TRYFAMILY(ANDQ) ELSE -1 ; ALL ← ALL ; comment SAIL bug -- force it to store;
END "CONJUNCTS" UNTIL ANDOP < 0 ;
ON ← WASONA ;
IF OROP < 0 OR FALSTR(ANY) THEN IF TRUESTR(ANY ← ALL) THEN ON ← FALSE ;
OROP ← TRYFAMILY(ORQ) ELSE -1 ; ANY ← ANY ; comment SAIL bug -- force it to store ;
END "DISJUNCTS" UNTIL OROP < 0 ;
ON ← WASONO ;
RETURN(DUMMYSTR ← ANY) ; comment, DUMMYSTR due to SAIL RECURSIVE STRING PROCEDURE bug (see DCS);
END "SIMPLE EXPRESSION" ;
SIMPLE PROCEDURE WARNLONG(STRING SEGM, MESG) ;
BEGIN
WARN(NULL, MESG & CRLF &
"[You probably omitted a template closer, )$ or ↑P or horseshoe]"
& CRLF & "The template began with:" & CRLF & SEGM[1 TO 70]) ;
END ;
STRING SIMPLE PROCEDURE DEFN(BOOLEAN SUBSTVARIABLES,FORFILE; INTEGER ARGS, IBASE) ;
BEGIN
STRING SEGMENT, IDENT, PSPCS, SPCS, FML, TXID, TX2 ;
INTEGER SINDX, I, DEEP, PGMKS, REQRS ;
LABEL FORMAL ;
IF ITSCH(;) THEN PASS ; DEFINING ← NOT FORFILE ; comment, makes RD include line nos in result ;
IF ¬ITSCH(⊂) AND NOT(ITSCH($) AND NEXTSCH("("))
THEN BEGIN WARN("=","Missed ⊂ OR $( in definition") ; RETURN(NULL) END ;
DEEP ← 1 ; SINDX ← SHIGH ;
IF SHIGH+20>STSIZE THEN
BEGIN
SGROW(STBL,STBLIDA,STSIZE,100,"Definition") ;
SMAKEBE(STBLIDA, STBL) ; ZEROSTRINGS(100, STBL[STSIZE-99]) ;
END ;
EMPTYTHIS ; comment For page label switch in LABELREF ;
IF FORFILE THEN STBL[SINDX←SINDX+1] ← SRCLINE & "/" & SRCPAGE & TB & ALTMODE ;
IF EQU(INPUTSTR[1:2], RCBRAK&VT) THEN
BEGIN
STBL[SINDX ← SINDX + 1] ← CRLF & SRCLINE & "/" & SRCPAGE & TB ;
INPUTSTR ← INPUTSTR[3:∞] ;
END ;
PGMKS ← PAGEMARKS ; REQRS ← LAST ; TES 8/19/74 ;
WHILE DEEP DO
BEGIN "DEF BODY"
SEGMENT ← RD(DEFN!TABLE) ;
IF BRC = "⊂" ∨ BRC="$"∧INPUTSTR="("∧LOP(INPUTSTR)="(" THEN
BEGIN DEEP ← DEEP + 1 ; SEGMENT ← SEGMENT & "⊂" ; END
ELSE IF BRC = "⊃" ∨ BRC=")"∧INPUTSTR="$"∧LOP(INPUTSTR)="$" THEN
BEGIN DEEP ← DEEP - 1 ;
SEGMENT ← SEGMENT & (IF DEEP THEN "⊃" ELSE SP) ;
END
ELSE IF BRC = "∃" THEN SEGMENT ← SEGMENT & (IF DEEP>1 THEN BRC ELSE NULL) & RD(ONE!CHAR)
ELSE IF LENGTH(TXID←BRC) ∧
(LDB(SPCODE(BRC))=LCURLY ∨
LDB(SPCODE(BRC))=DOLLAR ∧ LDB(SPCODE(INPUTSTR))=LBRACK ∧
LENGTH(TXID←TXID&LOP(INPUTSTR))) THEN
IF SUBSTVARIABLES THEN
BEGIN "{..."
SPCS ← TXID & RD(TO!VISIBLE) ;
IDENT ← SCAN(INPUTSTR,ALPHA,DUMMY) ; PSPCS ← RD(TO!VISIBLE) ;
IF BRC = RCBRAK ∨ BRC="]"∧INPUTSTR[2 FOR 1]="$"THEN
BEGIN
LOPP(INPUTSTR) ;
IF BRC="]" THEN BEGIN TX2←"]$" ; LOPP(INPUTSTR) END ELSE TX2←RCBRAK ;
SEGMENT ← SEGMENT &
(IF FULSTR(IDENT) ∧ SIMLOOK(CAPITALIZE(IDENT))
AND SYMTYPE<MACROTYPE THEN TES 11/29/73 ;
IF SYMIX=IXPAGE THEN ALTMODE&"[@]"&
LABELREF(0,
IF SYMBOL=SYMPAGE THEN CTR!CHRS(IXPAGE)
ELSE PATT!CHRS(IXPAGE))
ELSE EVALV(IDENT, SYMIX, SYMTYPE)
ELSE SPCS & IDENT & PSPCS & TX2)
END
ELSE SEGMENT ← SEGMENT & SPCS & IDENT & PSPCS ;
END "{..."
ELSE SEGMENT ← SEGMENT & TXID
ELSE IF BRC = RCBRAK THEN
IF EQU(INPUTSTR[1:2], RCBRAK&VT) THEN ELSE SEGMENT ← SEGMENT & BRC
ELSE IF LDB(FAMILY(BRC)) = LETTQ THEN
BEGIN "LETTER"
IDENT ← (BRC+0) & SCAN(INPUTSTR, ALPHA, BRC) ;
FOR I ← 1 THRU ARGS DO IF EQU(FML←SYM[ITBL[IBASE+I]], TXID←CAPITALIZE(IDENT)) THEN
FORMAL: BEGIN IDENT ← VT & I ; DONE END
ELSE IF 1 ≤ LENGTH(TXID)-LENGTH(FML) ≤ 2 THEN
BEGIN "MAYBE UNDERLINED"
INTEGER L, R ;
L ← IF TXID="_" THEN 1 ELSE 0 ; R ← IF TXID[∞ FOR 1]="_" THEN 1 ELSE 0 ;
IF EQU(FML, TXID[1+L TO ∞-R]) THEN
BEGIN
IF L THEN SEGMENT ← SEGMENT & "_" ;
IF R THEN INPUTSTR ← "_" & INPUTSTR ;
GO TO FORMAL ;
END ;
END "MAYBE UNDERLINED" ;
SEGMENT ← SEGMENT & IDENT ;
END "LETTER"
ELSE SEGMENT ← SEGMENT & BRC ;
STBL[SINDX ← SINDX+1] ← SEGMENT ;
IF SINDX = SHIGH+20 THEN
BEGIN
SEGMENT ← STBL[SHIGH + 1] ;
FOR I ← SHIGH + 2 THRU SINDX DO BEGIN SEGMENT ← SEGMENT & STBL[I] ; STBL[I]←NULL; END;
SINDX ← SHIGH + 1 ; STBL[SINDX] ← SEGMENT ;
IF DEEP THEN TES 8/19/74 CHECK FOR INFINITE TEMPLATE ;
IF LENGTH(SEGMENT) > MAXTEMPLATE THEN
BEGIN
WARNLONG(SEGMENT, "A template is longer than " &
CVS(MAXTEMPLATE) & " characters" & CRLF &
"If you really have such a long one, increase the value of maxtemplate") ;
STBL[SINDX] ← NULL ; DONE ;
END
ELSE IF PAGEMARKS > PGMKS THEN
BEGIN
WARNLONG(SEGMENT,
"A template crosses a manuscript page mark (form feed)") ;
STBL[SINDX] ← NULL ; DONE ;
END
ELSE IF LAST NEQ REQRS THEN
BEGIN
WARNLONG(SEGMENT, "A template crosses a file boundary (eof)") ;
STBL[SINDX] ← NULL ; DONE ;
END ;
END ;
END "DEF BODY" ;
SEGMENT ← STBL[SHIGH+1] ; FOR I ← SHIGH+2 THRU SINDX DO SEGMENT ← SEGMENT & STBL[I] ;
IF FORFILE THEN SEGMENT ← SEGMENT & LF ;
DEFINING ← FALSE ; INPUTSTR ← ";" & INPUTSTR ; PASS ;
RETURN(SEGMENT) ;
END "DEFN" ;
RECURSIVE PROCEDURE PARAMS(INTEGER MOST; STRING ARRAY PRE,PAR,POST);
BEGIN comment, Reads arguments for various commands;
INTEGER I, PREWD, SOFAR ; STRING EXPR ;
LABEL RDPAR, SETPAR ;
BOOLEAN GOT ; DEFINE FIND = "FOR I ← 1 THRU MOST DO IF" ;
SOFAR ← I ← GOT ← 0 ;
WHILE SOFAR<MOST ∧ THISTYPE≠-TERQ ∧ THISTYPE≠MANTYPE DO
BEGIN "PARAMETER"
IF THISISID THEN
BEGIN "IDENTIFIER"
IF ITS(TO) ∧ I<MOST ∧ ITSV(PRE[I+1]) THEN BEGIN PASS; I←I+1; GO TO RDPAR END;
FIND ITSV(PRE[I]) ∨ ITSV(PRE[I]&"S") THEN
BEGIN "PRE WORD"
PASS ; IF GOT LAND TWO(I) THEN WARN("=",PRE[I]&" Twice") ;
GO TO RDPAR ;
END "PRE WORD" ;
END "IDENTIFIER" ;
FIND ¬GOT LAND TWO(I) ∧ NULSTR(PRE[I]) ∧ (I=1 ∨ NULSTR(PRE[I-1]) ∨ GOT LAND TWO((I-1))) THEN GO TO RDPAR ;
DONE ;
RDPAR:
PREWD ← I ;
EXPR ← IF EQU(PRE[I],"IN") ∧ FULSTR(PAR[I]) THEN SPASS(THISWD) comment COUNT...IN -- ;
ELSE IF ITSCH(⊂) THEN 0 & DEFN(FALSE, FALSE, 0, 0)
ELSE E(NULL,IF I=MOST∨FULSTR(POST[I]) THEN POST[I] ELSE PRE[I+1]) ;
IF FULSTR(POST[I]) THEN
IF ITSV(POST[I]) THEN PASS
ELSE BEGIN "GUESSED WRONG"
FIND ITSV(POST[I]) THEN BEGIN PASS ; GO TO SETPAR END ;
FIND NULSTR(POST[I]) THEN GO TO SETPAR ;
WARN("=",POST[PREWD] & "Missed.") ;
DONE ;
END "GUESSED WRONG" ;
SETPAR:
IF PRE[I]≠PRE[PREWD] THEN WARN("=",(IF FULSTR(POST[PREWD]) THEN POST[PREWD] ELSE PRE[I])& " Missed.") ;
IF GOT LAND TWO(I) THEN WARN("=","Duplicate Parameter "&PRE[I]&SP&EXPR&SP&POST[I])
ELSE SOFAR ← SOFAR + 1 ;
GOT ← GOT LOR TWO(I) ;
PAR[I] ← EXPR ;
IF ITSCH(",") THEN PASS ;
END "PARAMETER" ;
END "PARAMS" ;
RECURSIVE STRING PROCEDURE SIMPAR ;
RETURN(IF THISISCON THEN THISWD[2 TO ∞] ELSE IF THISISID THEN VEVAL ELSE NULL) ;
SIMPLE PROCEDURE FINPORTION ;
BEGIN
DBREAK ;
IF OLDPGIDA THEN NEXTPAGE ;
END "FINPORTION" ;
RECURSIVE PROCEDURE DAREA(BOOLEAN TITAREA) ;
BEGIN
INTEGER I, IX, SYMB, TEMP, A, B ;
PRELOAD!WITH "LINE", "TO", "CHAR", "TO", "IN", "COLUMN", "COLUMN" ;
OWN STRING ARRAY PRE[1:7] ; STRING ARRAY PAR[1:7] ;
PRELOAD!WITH NULL, NULL, NULL, NULL, NULL, "WIDE", "APART" ;
OWN STRING ARRAY POST[1:7] ;
DBREAK; DPASS ;
IF ¬THISISID THEN BEGIN WARN("=","AREA must have name"); THISWD←"!DUMMY" END ;
SYMB ← SYMNUM(THISWD) ;
PASS ;
PARAMS(7, PRE, PAR, POST) ;
IF ¬ON THEN RETURN ;
BIND(DECLARE(SYMB, AREATYPE), IX←PUSHI(AREAWDS,AREATYPE)) ;
IF FULHIGH(IX)←NULSTR(PAR[1]) THEN BEGIN A←1 ; B←FHIGH END comment assume LINE 1 TO <frame height> ;
ELSE BEGIN A ← CVD(PAR[1]) ; B ← IF NULSTR(PAR[2]) THEN A ELSE CVD(PAR[2]) END ;
LINE1(IX) ← A MAX 1 ; LINECT(IX) ← B-A+1 MAX 1 ;
IF FULWIDE(IX)← NULSTR(PAR[3]) THEN BEGIN A←1 ; B←FWIDE END
ELSE BEGIN A ← CVD(PAR[3]) ; B ← IF NULSTR(PAR[4]) THEN A ELSE CVD(PAR[4]) END ;
CHAR1(IX) ← A MAX 1 ; CHARCT(IX) ← B←B-A+1 MAX 1 ;
TEXTAR(IX) ← IF TITAREA THEN 0 ELSE 1 ;
IF NULSTR(PAR[5]) THEN A ← 1 comment Assume IN 1 COLUMNS <charct> WIDE ;
ELSE BEGIN "COLUMNS"
A ← CVD(PAR[5]) ; comment How many ;
IF FULSTR(PAR[6]) THEN B ← CVD(PAR[6]) MIN B DIV A
ELSE B ← (B+( TEMP←IF FULSTR(PAR[7]) THEN CVD(PAR[7]) ELSE 5 )) DIV A - TEMP ;
END "COLUMNS" ;
COLCT(IX) ← A MAX 1 ; COLWID(IX) ← B MAX 1 ;
OLMAX ← OLMAX + A*LINECT(IX) ;
FOOTSTR(IX) ← PUSHS(1, NULL) ;
MARGINS(IX) ← FONTS(IX) ← 0 ; TES 11/15/73 ;
TFONT(IX) ← OFONT(IX) ← DEFAULTFONT ; TES 11/15/73 ;
END "DAREA" ;
PROCEDURE BURPAREAS(BOOLEAN VERBOSE) ;
BEGIN TES 8/19/74 CALLED BY DBURP ;
INTEGER NAREAS ; INTEGER ARRAY FOUND[1:100], THISAREA[0:ONE], AA[0:ONE,0:ONE] ;
PROCEDURE BURPAREADECL(INTEGER ILOC, IDA) ;
BEGIN
INTEGER I ;
OUTSTR(TB &
(IF TEXTAR(ILOC) THEN "TEXT " ELSE "TITLE ") &
"AREA " & SYM[LDB(BIXNUM(ILOC))] &
" LINES " & CVS(LINE1(ILOC)) & " TO " & CVS(LINE1(ILOC)+LINECT(ILOC)-1) &
" CHARS " & CVS(CHAR1(ILOC)) & " TO " & CVS(CHAR1(ILOC)+CHARCT(ILOC)-1) &
CRLF & TB & TB &
"IN " & CVS(COLCT(ILOC)) & " COLUMNS " &
CVS(COLWID(ILOC)) & " WIDE" &
(IF FULHIGH(ILOC) THEN " FULL HEIGHT" ELSE NULL) &
(IF FULWIDE(ILOC) THEN " FULL WIDTH" ELSE NULL) &
CRLF & TB & TB &
(IF DISD(ILOC) THEN "DISDECLARED AT " ELSE "DECLARED AT ") &
CVOS(ILOC) &
(IF (I ← OLD!ACTIVE(ILOC)) AND I NEQ IDA THEN " RECORD "&CVOS(I) ELSE NULL) &
(IF (I ← NEW!ACTIVE(ILOC)) THEN "NEWPAGE RECORD " & CVOS(I) ELSE NULL) &
(IF (I←MARGINS(ILOC)) THEN " MARGINS " & CVS(LMARGX(I)) & SP & CVS(RMARGX(I)) ELSE NULL) &
(IF XCRIBL THEN " FONTS " & PICKFONT(TFONT(ILOC))[3 TO ∞] &
"*" & PICKFONT(OFONT(ILOC))[3 TO ∞] ELSE NULL) &
(IF FULSTR("SSTK[FOOTSTR(ILOC)]") THEN " FOOTNOTES PENDING" ELSE NULL) &
CRLF) ;
END "BURPAREADECL" ;
PROCEDURE BURPAREARECORD(INTEGER ARIDA; BOOLEAN INFRAME) ;
BEGIN
INTEGER COLS, LINES, I, J, X, Y ;
BOOLEAN SOME ;
IDASSIGN(ARIDA, THISAREA) ;
IDASSIGN(AAA, AA) ;
OUTSTR("AREA RECORD " & CVOS(ARIDA) &
(IF NOT INFRAME THEN " NOT IN FRAME"
ELSE IF INA NEQ FRAMEIDA THEN " ** FRAME BACKLINK INCORRECT**"
ELSE NULL) &
(CASE STATA OF (" UNOPENED", " OPENED", " CLOSED", " DIS-DECLARED")) &
(CASE STATA MIN 2 OF (NULL,
" PLACING IN COLUMN "&CVS(IF AREAIDA=ARIDA THEN COL ELSE COLA),
" LINES " & CVS(ULLA) & " TO " & CVS(ULLA+LINECA-1) & " IN " & CVS(COLCA) & " COLUMNS")) &
(IF AREAIDA=ARIDA THEN " (CURRENT)" ELSE NULL) &
(IF XCRIBL THEN
(IF XGENA THEN " XGENLINES = "&CVS(XGENA) ELSE NULL)&
(IF OVERA THEN " OVEREST OF COLUMN 1 = "&CVS(OVERA) ELSE NULL)
ELSE NULL) &
CRLF) ;
IF VERBOSE THEN
BEGIN
COLS ← ARRINFO(AA, 2)/2 ; LINES ← ARRINFO(AA,4) ;
OUTSTR(TB&TB) ;
FOR I←1 THRU COLS DO OUTSTR(" COLUMN "&CVS(I)&TB) ;
OUTSTR(CRLF & TB & TB) ;
FOR I ← 1 THRU COLS DO OUTSTR(" CALF FOOT"&TB) ;
OUTSTR(CRLF) ;
FOR J ← 1 THRU LINES DO
BEGIN
SOME ← FALSE ;
FOR I ← 1 THRU 2*COLS DO IF AA[I,J] THEN BEGIN SOME←TRUE;DONE END ;
IF SOME THEN
BEGIN
OUTSTR(TB & " " & CVS(J) & TB) ;
FOR I ← 1 THRU COLS DO
FOR Y←0,COLS DO
OUTSTR(IF (X←AA[I+Y,J]) THEN (" "&CVS(OWLS[X]))[∞-5 TO ∞]&TB ELSE TB) ;
OUTSTR(CRLF) ;
END ;
END ;
OUTSTR(TB & " LAST"&TB) ;
FOR I ← 1 THRU COLS DO
OUTSTR(CVS(RH("AA[I,0]"))&TB&CVS(RH("AA[COLS+I,0]"))&TB) ;
OUTSTR(CRLF) ;
END ;
IF (I←DEFA) THEN BEGIN FOUND[NAREAS←NAREAS+1]←I ; BURPAREADECL(I, ARIDA) END ;
END "BURPAREARECORD" ;
INTEGER A, I, THISIDA, AAIDA ; BOOLEAN DID ;
MAKEBE(THISAREA, THISIDA) ; MAKEBE(AA, AAIDA) ;
IF FRAMEIDA=0 THEN OUTSTR("BETWEEN PAGES" & CRLF)
ELSE BEGIN
A ← ARF ; NAREAS ← 0 ;
WHILE A DO
BEGIN COMMENT SEARCH THIS FRAME ;
BURPAREARECORD(A, TRUE) ;
A ← ARA ;
END ;
END ;
A ← NULLAREAS ;
WHILE A DO
BEGIN COMMENT SEARCH NULL AREAS LIST (MADE BUT UNOPENED) ;
BURPAREARECORD(A, FALSE) ;
A ← RH(INA) ;
END ;
A ← IHED ;
WHILE A > 1 DO
BEGIN COMMENT SEARCH ISTK ;
IF IXTYPE(A) = AREATYPE THEN
BEGIN
DID ← FALSE ;
FOR I ← 1 THRU NAREAS DO IF FOUND[I]=A THEN
BEGIN DID ← TRUE ; DONE END ;
IF NOT DID THEN
BEGIN
OUTSTR("AREA HAVING NO RECORDS" & CRLF) ;
BURPAREADECL(A, 0) ;
END ;
END ;
A ← IXOLD(A) ;
END ;
MAKEBE(THISIDA, THISAREA) ; MAKEBE(AAIDA, AA) ;
END "BURPAREAS" ;
SIMPLE PROCEDURE BURPINPUT(BOOLEAN VERBOSE) ;
BEGIN
INTEGER L; STRING SL ;
OUTSTR("LINE/PAGE "&ERRLINE&"/"&SRCPAGE&TB&
SOMEINPUT[1 TO (IF VERBOSE THEN 300 ELSE 60)] ) ;
OUTSTR(CRLF&" - - - - - - - - - - - - - - - - - - - -"&CRLF) ;
FOR L ← LAST STEP -2 UNTIL (IF VERBOSE THEN 6 ELSE 6 MAX LAST-6) DO
BEGIN
SL ← LINESCAN(L) ;
IF CHANSCAN(L) GEQ 0 THEN OUTSTR(SCAN(SL,TO!VT!SKIP,DUMMY)) ;
OUTSTR(SP & SL & "/" & CVS(LH("DUMMY←ABS(PAGESCAN(L))")) & TB) ;
OUTSTR(STRSCAN(L)[1 TO (IF VERBOSE THEN 300 ELSE 60)]) ;
OUTSTR(CRLF&" - - - - - - - - - - - - - - - - - - - -"&CRLF) ;
END ;
END "BURPINPUT" ;
SIMPLE PROCEDURE DBELOW ;
BEGIN
END "DBELOW" ;
RECURSIVE PROCEDURE DBLANKPAGE ;
BEGIN COMMENT LEAVE N BLANK PAGES WITHOUT AFFECTING THE PAGE NUMBER ;
INTEGER I, J, N ;
PASS ; N ← CVD(E("1", NULL)) ;
IF ¬ON THEN RETURN ;
DBREAK ;
IF OLDPGIDA THEN NEXTPAGE ;
IF INTER ≤ 0 THEN NOPORTION ;
FOR I ← 1 THRU N DO FOR J ← PHIGH, PWIDE, ODDLEFTBORDER, -10 DO WORDOUT(INTER, J) ;
END ;
SIMPLE PROCEDURE DBURP ;
BEGIN TES 8/19/74 DEBUG PRINTOUTS ;
BOOLEAN VERBOSE ;
IF ON AND NOT SWDBACK THEN BEGIN OUTSTR(CRLF); SWDBACK←TRUE END ;
PASS ;
IF ITS(INPUT) THEN
BEGIN
PASS ;
VERBOSE ← IF ITS(VERBOSE) THEN IPASS(TRUE) ELSE FALSE ;
IF ON THEN BURPINPUT(VERBOSE) ;
END
ELSE IF ITS(AREAS) THEN
BEGIN
PASS ;
VERBOSE ← IF ITS(VERBOSE) THEN IPASS(TRUE) ELSE FALSE ;
IF ON THEN BURPAREAS(VERBOSE) ;
END
ELSE WARN(NULL, "Unrecognized BURP command " & THISWD) ;
END "DBURP" ;
SIMPLE PROCEDURE DCC ;
BEGIN
END "DCC" ;
RECURSIVE PROCEDURE DCLOSE ;
BEGIN
DBREAK ; PASS ;
IF ON THEN
IF THISTYPE=AREATYPE THEN CLOSEAREA(IX,FALSE)
ELSE IF IX=IXPAGE THEN comment, * * * * * * * * * * * * * ;
ELSE WARN("=","CLOSE What? "&SOMEINPUT) ;
PASS ;
END "DCLOSE" ;
SIMPLE PROCEDURE DCOMMANDCHARACTER ;
BEGIN
INTEGER X ;
INPUTSTR ← ";;" & INPUTSTR ; COMMENT couple extra semicolons to assure next line read right ;
PASS ; X ← SIMPAR ;
IF LENGTH(X) ≠ 1 THEN WARN("=","COMMAND CHARACTER must be a single character, not `"&X&"'")
ELSE IF ON THEN COMMAND!CHARACTER ← X ;
PASS ; PASS ; PASS ;
END "DCOMMANDCHARACTER" ;
SIMPLE PROCEDURE DCOUNT ;
BEGIN
INTEGER USYMB, INLINE ;
PRELOAD!WITH "FROM", "TO", "BY", "IN", "PRINTING" ;
OWN STRING ARRAY PRE[1:5] ; OWN STRING ARRAY PAR[1:5] ;
DPASS ; IF ¬THISISID THEN BEGIN WARN("=","Unit must have a name") ; THISWD ← "!DUMMY" END ;
USYMB ← SYMNUM(THISWD) ; PASS ; IF ITS(INLINE) THEN BEGIN INLINE←TRUE; PASS END ELSE INLINE←FALSE ;
PAR[1]←PAR[2]←PAR[3]←PAR[5]←NULL;
PAR[4] ← 0 ; PARAMS(5, PRE, PAR, NULLS) ;
IF ON THEN CREUNIT( INLINE,
IF NULSTR(PAR[1]) THEN 1 ELSE CVD(PAR[1]), comment, FROM -- ;
IF NULSTR(PAR[2]) THEN 18 ELSE CVD(PAR[2]), comment, TO -- ;
IF NULSTR(PAR[3]) THEN 1 ELSE CVD(PAR[3]), comment, BY -- ;
IF PAR[4] = 0 THEN 0 ELSE SYMNUM(PAR[4]), comment IN -- ;
IF NULSTR(PAR[5]) THEN "1" ELSE PAR[5], comment, PRINTING -- ;
USYMB ) ;
END "DCOUNT" ;
SIMPLE PROCEDURE DDEVICE ;
BEGIN PASS ;
RKJ: 19-AUG-74 ADDED ON BELOW;
IF DEVICE ≥ 0 AND ON THEN COMMENT IF <0, WAS SET BY /SWITCH, WHICH TAKES PRECEDENCE ;
IF ITS(MIC) THEN DEVICE←MIC ELSE IF ITS(TTY) THEN DEVICE←TTY
ELSE IF ITS(LPT) THEN DEVICE←LPT
ELSE IF ITS(XGP) THEN BEGIN DEVICE ← XGP; XCRIBL ← TRUE; OUTSTR(" XCRIBL!"); END
ELSE WARN("=","No such device: "&THISWD) ;
PASS ;
END "DDEVICE" ;
SIMPLE PROCEDURE DDONE(BOOLEAN RETURNS) ;
BEGIN TES 8/14/74 (DONE) 8/19/74 (RETURN);
INTEGER B ; STRING VAL ; BOOLEAN GOT ;
PASS ;
IF ON THEN
IF NOT RETURNS AND REPEATS=0 THEN WARN(NULL,"Ignored a DONE without a repeat")
ELSE IF RETURNS AND PROCEDURES=0 THEN WARN(NULL, "Ignored a RETURN not in a PROCEDURE")
ELSE
BEGIN
IF RETURNS THEN
BEGIN
PROCEDURES ← PROCEDURES - 1 ;
IF ITSCH("(") THEN
BEGIN COMMENT VALUE TO RETURN ;
PASS ;
VAL ← E(NULL, NULL) ;
IF NOT ITSCH(")") THEN WARN(NULL, "Missed ) after RETURN") ;
END
ELSE VAL ← NULL ;
END
ELSE REPEATS ← REPEATS - 1 ;
EMPTYTHIS ; EMPTYTHAT ; INPUTSTR ← NULL ;
DO BEGIN
WHILE LAST AND CHANSCAN(LAST) > -2 DO
INPUTSTR ← SWICHBACK ;
GOT ← RETURNS EQV EQU("RETURN(", STRSCAN(LAST)[1 TO 7]) ;
STRSCAN(LAST) ← NULL ;
IF NOT GOT THEN CHANSCAN(LAST)←-1 ;
END UNTIL GOT ;
B ← -2 - CHANSCAN(LAST) ;
WHILE B<BLNMS DO
CASE IF STARTS THEN 0 ELSE ENDCASE OF
BEGIN
BEGIN BLNMS←BLNMS-1 ; STARTS←STARTS-1 ; END ;
BEGIN BLNMS←BLNMS-1 ; IF ENDBLOCK THEN WARN("=","Missed END") END ;
IF ENDBLOCK THEN WARN("=", "Missed END") ELSE
BEGIN BLNMS←BLNMS-1 ; IF ENDBLOCK THEN WARN("=","Missed END") END ;
BEGIN BLNMS←BLNMS-1 ; IF ENDBLOCK THEN MYEND ← TRUE ELSE WARN("=","Extra END") END ;
END ;
CHANSCAN(LAST) ← -1 ;
INPUTSTR ← SWICHBACK ;
PASS ;
IF RETURNS THEN PROCVALUE ← VAL ;
END ;
END "DDONE" ;
RECURSIVE PROCEDURE DCONDITIONAL ;
BEGIN
BOOLEAN WASON ;
WASON ← ON ; PASS ; ON ← TRUESTR("E(NULL,""THEN"")") ∧ WASON ;
IF ITS(THEN) THEN PASS ELSE WARN("=","Missed THEN in conditional statement") ;
IF STATEMENT THEN BEGIN ON←TRUE; RETURN END; TES 8/14/74 DONE FROM REPEAT ;
IF ITS(ELSE) THEN BEGIN ON←WASON∧¬ON; PASS ; IF STATEMENT THEN BEGIN ON←TRUE; RETURN END END ;
ON ← WASON ;
END "DCONDITIONAL" ;
INTERNAL SIMPLE PROCEDURE READFONT(INTEGER WHICH; STRING FILENAME, BFILENAME) ;
IF ON THEN
BEGIN "READFONT"
INTEGER SAVCW, CHAN, ZILCH, EOF;
IFC TENEX THENC STRING ELSEC INTEGER ENDC NAME, EXT, PPN ;
STRING XFILENAME ;
LABEL TRYAGAIN ; COMMENT SAIL DEFFICIENCY ;
IF NULSTR(BFILENAME) THEN
IFC TENEX THENC
BEGIN
NAME←CVFIL(FILENAME,EXT,PPN) ;
XFILENAME ← NAME & EXT ;
END
ELSEC
XFILENAME ← FILENAME TES 1/22/74 ;
ENDC
ELSE XFILENAME ← BFILENAME ;
SAVCW ← WHATIS(CW);
IF FONTFIL[WHICH] = 0 THEN FONTFIL[WHICH] ← CREATE(0,127);
DUMMY ← FONTFIL[WHICH] ;
IF SAVCW=WCW AND WHICH=DEFAULTFONT THEN SAVCW←DUMMY;
MAKEBE(DUMMY,CW);
OPEN(CHAN←GETCHAN,"DSK",'14, 2,0,0,ZILCH,EOF);
IFC TENEX THENC
LOOKUP(CHAN, FILENAME, FLAG) ;
IF FLAG THEN
BEGIN "HUNTFONT"
ENDC
TRYAGAIN: NAME←CVFIL(FILENAME,EXT,PPN);
WHILE TRUE DO
BEGIN "LKUPLOOP"
IF XLOOKUP(CHAN,NAME,EXT,0,PPN) THEN DONE;
IF EXT=0 THEN EXT←FONTEXT ELSE
IF PPN=0 THEN PPN←FONTPPN ELSE
IF FULSTR(BFILENAME) AND NOT EQU(FILENAME,BFILENAME) THEN
BEGIN
FILENAME ← BFILENAME ;
GO TRYAGAIN ;
END ELSE
BEGIN "NOTFOUND"
OUTSTR("Font file " & FILENAME & " not found. Read file: ");
IFC TENEX THENC
RELEASE(CHAN);
CHAN ← OPENFILE(NULL,"ROC") ;
DONE ;
ELSEC
FILENAME ← INCHWL ;
GO TRYAGAIN ;
ENDC
END "NOTFOUND";
END "LKUPLOOP";
IFC TENEX THENC
END "HUNTFONT" ;
ENDC
IFC VERSION=ITSVER THENC PJ 5/28/74 ;
WORDIN(CHAN);
FNTINF[WHICH]←WORDIN(CHAN);
IF WHICH=DEFAULTFONT THEN BASELINE←LDB(POINT(9,FNTINF[WHICH],17));
FNTINF[WHICH]←LDB(POINT(18,FNTINF[WHICH],35)); ie HEIGHT;
WHILE NOT EOF DO
IF (WORDIN(CHAN) LAND 1) THEN
BEGIN
DUMMY←LDB(POINT(18,DUMMY←WORDIN(CHAN),35));
CW[DUMMY]←LDB(POINT(18,CW[DUMMY]←WORDIN(CHAN),35));
END
ENDC
IFC VERSION=CMUVER THENC RKJ: MODIFIED 3-SEP-74;
WORDIN(CHAN); COMMENT KST ID;
FNTINF[WHICH]←WORDIN(CHAN); COMMENT RKJ 10-10-73;
IFC CMUKST2 THENC
IF WORDIN(CHAN) NEQ 2 THEN
WARN(NULL,"File "&FILENAME&" has the old KSET format. See FORMAT.KST[A730KS00]"&CRLF&
"Unpredictable results if you continue");
IF WHICH=DEFAULTFONT THEN BASELINE←WORDIN(CHAN) ELSE WORDIN(CHAN);
ARRYIN(CHAN,CW[0],6); COMMENT UNUSED WORDS;
ARRYIN(CHAN,CW[0],128); COMMENT XWD INCR,WIDTH;
FOR I←0 THRU 127 DO CW[I]←CW[I] LSH -18;
ELSEC
WHILE NOT EOF DO
IF (WORDIN(CHAN) LAND 1) THEN
BEGIN DUMMY←WORDIN(CHAN); CW[DUMMY]←WORDIN(CHAN) END
ENDC
ENDC
IFC VERSION=SAILVER THENC
ARRYIN(CHAN,CW[0],128);
FOR I ← 0 THRU 127 DO CW[I] ← CW[I] LSH -18;
WORDIN(CHAN); FNTINF[WHICH]←WORDIN(CHAN);
WORDIN(CHAN);
IF WHICH=DEFAULTFONT THEN BASELINE←WORDIN(CHAN);
ENDC
IFC VERSION=PARCVER THENC
BEGIN
EXTERNAL INTEGER GOGTAB;
INTEGER K,I;
IFC TENEX THENC
DEFINE JSYS="'104000000000", SFBSZ="JSYS '46";
K ← CVJFN(CHAN) ;
START!CODE "BYTE16"
MOVE 1,K; MOVEI 2,16; SFBSZ ;
END "BYTE16" ;
ELSEC
START!CODE "BYTE16" MOVE 1,GOGTAB; ADD 1,CHAN; MOVE 1,'13(1); comment now we have pointer to cdb;
HRRZ 1,2(1); comment now pointer to IBUF;
HRLI 2,'442000;
HLLM 2,1(1);
END "BYTE16";
ENDC
K←WORDIN(CHAN); WORDIN(CHAN);
FNTINF[WHICH]←WORDIN(CHAN); WORDIN(CHAN);
FOR I←1 THRU K DO WORDIN(CHAN);
K←(K MIN 128)-1;
FOR I←0 THRU K DO CW[I]←WORDIN(CHAN);
END;
ENDC;
IFC VERSION=SAILVER THENC CMDFILE ← CMDFILE & "/FONT#" & CVS(WHICH-1) & "=" & FILENAME ENDC;
IFC VERSION=ITSVER THENC PJ 6/12/74 ;
CMDFILE ← CMDFILE & ";KSET "&(",,,,,,,,,,"[1 FOR WHICH-1])&FILENAME & CRLF ;
ENDC
TES 1/7/74 ADDED NEXT LINE: ; TES 1/22/74 PUT XFILENAME ;
FNTNAME[WHICH]←XFILENAME; HIFONT←WHICH MAX HIFONT ;
RELEASE(CHAN);
MAKEBE(SAVCW,CW);
END "READFONT";
INTERNAL SIMPLE PROCEDURE SWITCHFONT(INTEGER WHICH) ;
BEGIN TES 11/15/73 TO DO IT BY AREA ;
INTEGER NEWIX ;
IF AREAIXM AND FONTS(AREAIXM) < OLDIHED THEN
BEGIN TES FIRST CHANGE IN THIS BLOCK IN THIS AREA ;
NEWIX ← PUSHI(FONTWDS, FONTYPE) ;
AREAX(NEWIX) ← AREAIXM ;
OUTERX(NEWIX) ← FONTS(AREAIXM) ;
THISFONTX(NEWIX) ← THISFONT ;
OLDFONTX(NEWIX) ← OLDFONT ;
FONTS(AREAIXM) ← NEWIX ;
END ;
OLDFONT ← THISFONT;
IF THISFONT NEQ WHICH THEN
BEGIN
THISFONT ← WHICH;
WHICH ← FONTFIL[WHICH]; MAKEBE(WHICH,CW);
END ;
END ;
INTERNAL SIMPLE PROCEDURE SELECTFONT(INTEGER WHICH);
IF ON THEN
BEGIN "SELECTFONT"
INTEGER F;
DBREAK;
IF NOT XCRIBL OR LAST<4 THEN RETURN;
F←(IF WHICH<10 THEN (WHICH+"0") ELSE (WHICH+("A"-10)));
IF FONTFIL[WHICH]=0 THEN BEGIN WARN("=","Unknown font `"& F & "'");
RETURN END;
SWITCHFONT(WHICH) ; TES 11/14/73 SUBROUTINIZED ;
TES 11/15/73 erased: XGPCMD ← (FONTCHAR & "F") & F ;
END "SELECTFONT";
INTERNAL SIMPLE INTEGER PROCEDURE RFONT(INTEGER F) ;
RETURN( TES SUBROUTINIZED AND CASED 11/29/73 ;
IFC VERSION = SAILVER OR VERSION=ITSVER PJ 5/28/74 ; THENC
IF "1"≤F≤"9" THEN F←F-"0"
ELSE IF "A"≤F≤"Z" THEN F←F-("A"-10)
ELSE IF "a"≤F≤"z" THEN F←F-("a"-10)
ELSE -1
ENDC
IFC VERSION = PARCVER THENC
IF "1"≤F≤"9" THEN F←F-"0"
ELSE -1
ENDC
IFC VERSION = CMUVER THENC
IF "A"≤F≤"B" THEN F←F-("A"-10)
ELSE IF "a"≤F≤"b" THEN F←F-("a"-10)
ELSE IF "1"≤F≤"2" THEN F←F-"0"
ELSE -1
ENDC
) ;
SIMPLE PROCEDURE DFONT(BOOLEAN SELECT);
BEGIN "DFONT"
INTEGER F;
PASS;
IF LENGTH(THISWD)=1 AND THISTYPE GEQ 0 AND (F←RFONT(THISWD)) GEQ 0 THEN PASS
ELSE F ← RFONT(E(NULL,NULL)) ; TES 11/29/73 ;
IF F<0 THEN
BEGIN WARN("=","Illegal font `"&F&"'"); RETURN END;
IF SELECT THEN SELECTFONT(F) TES 1/22/74 ADDED OPTIONAL XGP FILENAME ;
ELSE READFONT(F,E(NULL,NULL), IF ITSCH(",") THEN PASS&E(NULL,NULL) ELSE NULL);
END "DFONT";
RECURSIVE PROCEDURE DFRAME(BOOLEAN BOXFRM) ;
BEGIN
INTEGER L, I ;
PRELOAD!WITH "HIGH", "WIDE" ; OWN STRING ARRAY POST[1:2];
STRING ARRAY PAR[1:2] ;
DAPART ; PASS ; PARAMS(2,NULLS,PAR,POST);
IF ON THEN
IF BOXFRM THEN BEGIN END
ELSE
BEGIN
PHIGH←FHIGH←IF NULSTR(PAR[1]) THEN 1 ELSE CVD(PAR[1]) ;
PWIDE←FWIDE←IF NULSTR(PAR[2]) THEN 1 ELSE CVD(PAR[2]) ;
IF OLDPGIDA THEN NEXTPAGE ;
L ← NULLAREAS ;
WHILE L DO BEGIN
I ← AREAIDA ; IDASSIGN(AREAIDA←L,THISAREA) ; L ← RH(INA) ;
OPEN!ACTIVE(DEFA) ← 0 ; GOAWAY(AREAIDA) ; IF (AREAIDA←I) THEN IDASSIGN(AREAIDA,THISAREA) ;
END ;
NULLAREAS ← 0 ;
END ;
END "DFRAME" ;
SIMPLE PROCEDURE DINDENT ;
BEGIN
STRING X ;
DBREAK ; PASS ; X ← E(NULL,NULL) ; IF ON ∧ FULSTR(X) THEN FIRSTIM ← CVD(X) ;
IF ITSCH(",") THEN BEGIN PASS ; X←E(NULL, NULL) END ELSE X←NULL ;
IF ON ∧ FULSTR(X) THEN RESTIM←CVD(X) ;
IF ITSCH(",") THEN BEGIN PASS ; X←E(NULL, NULL) END ELSE X←NULL ;
IF ON ∧ FULSTR(X) THEN RIGHTIM←CVD(X) ;
END "DINDENT" ;
SIMPLE PROCEDURE DINSERT ;
BEGIN
INTEGER CHAN, PIX, ROTTEN ;
IF ON THEN BEGIN TES 4/11/74;
FINPORTION ;
IF INTER ≥ 0 THEN
BEGIN FOR DUMMY←1 THRU 5 DO WORDOUT(INTER,-20) ; RELEASE(INTER) ; RELEASE(SINTER) ; SINTER←INTER←-1 END ;
END ;
DO BEGIN "COLLATE"
DPASS ; IF ¬THISISID THEN BEGIN WARN("=","Unnamed INSERT Portion!") ; RETURN END ;
IF ON THEN
BEGIN ROTTEN ← FALSE ;
IF THISTYPE ≠ PORTYPE THEN
BEGIN
BIND(SYMB←DECLARE(SYMB, PORTYPE), PIX ← PUTI(4, -5));
PORSTR(PIX) ← PUTS(NULL) ; PUTS(NULL) ; TES 3/21/74;
END
ELSE IF (CHAN ← PORCH(PIX ← IX)) = -1 THEN BEGIN WARN("=","Can't INSERT FOOT!"); ROTTEN←TRUE END
ELSE IF ¬(0 ≤ CHAN ≤ 15) THEN BEGIN WARN("=","Can't INSERT passed PORTION "&THISWD) ; ROTTEN←TRUE END ;
IF ¬ROTTEN THEN BEGIN PORSEQ(SEQPORT) ← PIX ; PORSEQ(SEQPORT ← PIX) ← -1 END ;
PASS ;
END ;
END "COLLATE" UNTIL ¬ITSCH(",") ;
END "DINSERT" ;
SIMPLE PROCEDURE DLET ;
BEGIN
INTEGER LOC ; LABEL BADLET ;
DPASS ; IF THATISID THEN BEGIN THATWD ← THISWD & THATWD ; DPASS END ; LOC ← SYMB ;
IF ¬THISISID THEN GO TO BADLET ; PASS ; IF ¬ITSCH(=) THEN GO TO BADLET ; DPASS ;
IF THISTYPE≠MANTYPE AND THATISID THEN BEGIN THATWD←THISWD&THATWD ; PASS END ;
IF THISTYPE≠MANTYPE THEN GO TO BADLET ; IF ON THEN BIND(LOC←DECLARE(LOC, MANTYPE), IX) ; PASS ;
RETURN ;
BADLET: WARN("=","LET <ID>=<RESWD>, please!") ; DO PASS UNTIL THISISID ∨ THISTYPE=-TERQ ;
END "DLET" ;
SIMPLE PROCEDURE DLOCK ;
BEGIN
END "DLOCK" ;
SIMPLE PROCEDURE DLOCAL ;
DO BEGIN
DPASS ;
IF THISISID THEN
BEGIN
IF ON THEN
BIND(SYMB←DECLARE(SYMB, LOCALTYPE), IX←PUSHS(1,NULL)) ;
PASS ;
END
ELSE BEGIN WARN("=","LOCAL declaration missing identifier"); IF THISTYPE≠TERQ THEN PASS END ;
END UNTIL ¬ITSCH(",") ;
SIMPLE PROCEDURE DMACRO(INTEGER ODDONE) ; TES 8/19/74 ODDONE= 0:RECURSIVE MACRO 1:MACRO 2:PROCEDURE;
BEGIN COMMENT, OLD VERSION NOT GARBAGED BUT COULD BE ;
INTEGER SIHIGH, MIX, ARGS, J, NAMES, NAME ; BOOLEAN ROTTEN ;
SIHIGH ← IHIGH ; DPASS ; IF ¬THISISID THEN BEGIN WARN("=","Macro name not identifier") ; RETURN END ;
IF THATISID THEN BEGIN "TWO WORD" THISWD ← THISWD & SP & THATWD ; RDENTITY ; END "TWO WORD" ;
PUTI(1, SYMNUM(THISWD)) ; PASS ;
IF ITSCH("(") THEN
BEGIN "FORMALS"
ROTTEN ← FALSE ; THISWD ← "," ; NAMES ← 0 ;
DO BEGIN
IF ITSCH(",") THEN DPASS
ELSE BEGIN WARN("=","Missed comma in macro formal list") ; ROTTEN←TRUE END ;
IF ITSCH(ε) THEN BEGIN DPASS ; NAME ← 0 ; END ELSE NAME ← 1 ;
IF ¬THISISID THEN BEGIN WARN("=","Formal parameters must be identifiers") ; ROTTEN←TRUE END
ELSE BEGIN PUTI(1, SYMB) ; NAMES ← 2*NAMES + NAME ; DPASS END ;
END
UNTIL ITSCH(")") ∨ ROTTEN ;
IF ITSCH(")") THEN PASS ;
END "FORMALS" ;
IF ROTTEN ∨ ¬ON THEN BEGIN IHIGH ← SIHIGH ; DEFN(FALSE, FALSE,0,0) ; RETURN END ;
ARGS ← IHIGH - SIHIGH - 1 ; BIND(DECLARE(ITBL[SIHIGH+1], MACROTYPE), MIX←PUSHI(MACROWDS,MACROTYPE)) ;
NUMARGS(MIX) ← ARGS ; ODDMAC(MIX) ← ODDONE ; BODY(MIX) ← PUSHS(1,DEFN(FALSE, FALSE,ARGS,SIHIGH+1)) ;
IHIGH ← SIHIGH ; NAMEPAR(MIX) ← NAMES ;
END "DMACRO" ;
SIMPLE PROCEDURE DMARGINS(BOOLEAN INWARD) ;
BEGIN
STRING S ; INTEGER L, R, W, ARIX, OLDIX, NEWIX ;
IF ON THEN DBREAK ;
ARIX ← IF AREAIXM THEN AREAIXM ELSE IXTEXT ; OLDIX ← MARGINS(ARIX) ; PASS ;
S ← IF THISTYPE > INTERNTYPE ∨ THISTYPE=-TERQ ∨ NEXTSCH(←) ∨ NEXTSCH(:) THEN NULL
ELSE E(NULL, NULL) ;
IF FULSTR(S) ∨ ITSCH(",") THEN
BEGIN "HAS PARAMS"
L ← IF FULSTR(S) THEN CVD(S) ELSE 0 ;
IF ITSCH(",") THEN BEGIN PASS ; R ← CVD(E("0",NULL)) END ELSE R ← 0 ;
IF ¬ON THEN RETURN ;
MARGINS(ARIX) ← NEWIX ← PUSHI(MARGWDS, MARGTYPE) ; W ← COLWID(ARIX) ;
LMARG ← (IF OLDIX THEN LMARGX(OLDIX) ELSE 0) + INWARD*L MAX 0 MIN W-1 ;
RMARG ← (IF OLDIX THEN RMARGX(OLDIX) ELSE W) - INWARD*R MIN W MAX LMARG+1 ;
LMARGX(NEWIX) ← LMARG ; RMARGX(NEWIX) ← RMARG ;
AREAX(NEWIX) ← ARIX ; OLD!MARGX(NEWIX) ← OLDIX ;
END "HAS PARAMS"
ELSE IF ¬ON THEN RETURN
ELSE IF OLDIX THEN
BEGIN "UNNEST"
AREAX(OLDIX) ← 0 ; comment, so ENDBLOCK won't use it ;
MARGINS(ARIX) ← NEWIX ← OLD!MARGX(OLDIX) ;
LMARG ← IF NEWIX THEN LMARGX(NEWIX) ELSE 0 ;
RMARG ← IF NEWIX THEN RMARGX(NEWIX) ELSE COLWID(ARIX) ;
IF OLDIX = IHED THEN IHED ← IHED - 1 - MARGWDS ;
END "UNNEST"
ELSE WARN("=","Extra "&(IF INWARD>0 THEN "NARROW" ELSE "WIDEN")&" in Margin Nest") ;
END "DMARGINS" ;
RECURSIVE PROCEDURE DNEXT ;
BEGIN
COMMENT Already PASSed "NEXT" ;
IF ¬THISISID ∨ (THISTYPE ≠ UNITTYPE ∧ THISTYPE ≠ PUNITTYPE) THEN WARN("=","NEXT what?")
ELSE IF ON THEN IF IX=IXPAGE THEN NEXTPAGE ELSE USTEP(SYMB, IX) ;
PASS ;
END "DNEXT" ;
SIMPLE PROCEDURE DPACK ;
BEGIN
END "DPACK" ;
RECURSIVE PROCEDURE DPICHAR ;
BEGIN TES 11/29/73 ;
INTEGER KEY, IX, F, N ; STRING S ;
INPICHAR ← TRUE ;
PASS ;
KEY ←E(NULL,NULL) ;
IF ITSCH("(") THEN
BEGIN COMMENT TURN ON ;
PASS ;
DO S ← S & E(NULL,NULL) UNTIL ITSCH(")") ;
PASS ;
IF ITS(WIDTH) THEN
BEGIN PASS ;
IF ITS(OF) THEN BEGIN PASS ; F←'177; N←CVD(E(NULL,NULL)) END
ELSE BEGIN F←CVD(E(NULL,NULL)); N←F MOD '177; F←F DIV '177 END
END
ELSE BEGIN F←'177 ; N ← SP END ;
S ← F & N & S ;
END
ELSE S ← NULL ; COMMENT TURN OFF ;
IX ← PUSHI(PIWDS,PITYPE) ;
PIKEY(IX) ← KEY ; PIVAL(IX) ← PUSHS(1, PICHAR[KEY]) ;
PICHAR[KEY] ← S ;
INPICHAR ← FALSE ;
END "DPICHAR" ;
SIMPLE PROCEDURE DPORTION ;
BEGIN
INTEGER CHAN, PSIX, PIX ; STRING IFIL ; LABEL WASFWD ;
DPASS ; IF ¬THISISID THEN BEGIN WARN("=","Unnamed PORTION!") ; RETURN END ;
IF ¬ON THEN BEGIN PASS ; RETURN END ;
FINPORTION ;
IF THISTYPE ≠ PORTYPE THEN
BEGIN
BIND(SYMB←DECLARE(SYMB, PORTYPE), PIX ← PUTI(4, -2)) ;
PORSTR(PIX) ← PUTS(NULL) ; PUTS(NULL);
PORSEQ(PIX) ← 0 ;
END
ELSE IF 0 ≤ (CHAN ← PORCH(PIX ← IX)) THEN BEGIN RELEASE(CHAN) ; PORCH(PIX) ← -3 ; GO TO WASFWD END
ELSE IF CHAN = -1 THEN BEGIN WARN("=","Can't declare PORTION FOOT!") ; PASS ; RETURN END
ELSE IF CHAN ≠ -5 THEN WARN("=","PORTION "&THISWD&" already declared!")
ELSE IF PORSEQ(THISPORT) ≠ PIX THEN
BEGIN PORCH(PIX) ← -2 ; COMMENT ADDED FEB 6, 1973 ;
WASFWD: BEGIN
IF INTER ≥ 0 THEN
BEGIN FOR DUMMY←1 THRU 5 DO WORDOUT(INTER,-20) ; RELEASE(INTER) ; RELEASE(SINTER) END ;
INTER ← SINTER ← -1 ;
END ;
END ;
IF INTER < 0 THEN
BEGIN
PSIX ← PORSTR(PIX) ;
IFC TENEX THENC
IFIL ← CVS(INTERS←INTERS+1) ; PORINT(PSIX) ← IFIL ;
INTER ← WRITEON(TRUE,IFILENAME&OCTEXT&IFIL) ;
SINTER← WRITEON(FALSE,IFILENAME&TXTEXT&IFIL) ;
ELSEC
IFIL ← "PUI"&CVS(INTERS←INTERS+1) ;
PORINT(PSIX)←IFIL ;
INTER←WRITEON(TRUE,IFIL&PUIEXT) ; SINTER←WRITEON(FALSE,IFIL&"S"&PUIEXT) ;
ENDC
END ;
IF PORSEQ(PIX) = 0 THEN
BEGIN
PORSEQ(SEQPORT) ← PIX ;
SEQPORT ← PIX ;
END ;
THISPORT ← PIX ; PORTS ← PORTS + 1 ;
PASS ;
END "DPORTION" ;
SIMPLE PROCEDURE DPUB!DEBUG ;
IF NOT ON THEN PASS ELSE
BEGIN "BUGLOOP"
STRING INPT ;
IF FULSTR(INPT←TYPEIN) THEN
BEGIN
SWICH("TTY←" & SUBST(SUBST(INPT, TB, SP, SP), CRLF&"##", ";"&CRLF&TB, CRLF&TB) & TES 8/23/74 SUBST;
(CRLF & TB & TB & "PUB!DEBUG" & CRLF & TB & TB),
-1, 0) ;
PASS ;
END
ELSE PASS ;
END "BUGLOOP" ;
SIMPLE PROCEDURE DRECEIVE ;
BEGIN
STRING A ;
IF THATISCON ∧ 1≤ LENGTH(THATWD)-1 ≤2 THEN BEGIN PASS ; A ← THISWD[2 TO ∞] END
ELSE A ← NULL ;
IF ON THEN RECEIVE(THISPORT, A) ; PASS ;
END "DRECEIVE" ;
SIMPLE PROCEDURE DREPEAT ;
BEGIN TES 8/14/74 ;
STRING BOD ;
PASS ;
BOD ← DEFN(FALSE, FALSE, 0, 0) ;
IF ON THEN
BEGIN
REPEATS ← REPEATS + 1 ;
SWICH(BOD, -2-BLNMS, 0) ;
SWICH(BOD, -1, 0) ;
PASS ;
END ;
END "DREPEAT" ;
SIMPLE PROCEDURE DRESPONSE(INTEGER COMDWD) ;
BEGIN
INTEGER ARGS, SIHIGH, L1, L2, SIG, CLU, VARI, S, A, RIX, J, TYP, XIX, OLDIX ;
STRING PHR, X, BOD ; BOOLEAN ROTTEN, HASBODY ;
SIMPLE PROCEDURE RESPREPL ;
BEGIN
RIX ← PUSHI(RESPWDS, RESPTYPE) ;
NEXT!RESP(RIX) ← LLPOST ; OLD!RESP(RIX) ← LLTHIS ;
END "RESPREPL" ;
ROTTEN ← FALSE ; ARGS ← 0 ; SIHIGH ← IHIGH ;
IF COMDWD = 1 THEN
BEGIN "AT"
PASS ;
IF ITS(PAGEMARK) THEN BEGIN VARI←2 ; CLU←0 ; L1←FF ; SIG←FF ROT -7 ; PASS END
ELSE BEGIN
X ← SIMPAR ; L1 ← X ;
IF NULSTR(X) THEN BEGIN VARI←2 ; CLU←0 ; L1←CR ; SIG←CR ROT -7 ; PASS END
ELSE IF THISWD[1 FOR 1]="0" THEN BEGIN VARI←1 ; CLU←CVD(X) ; PASS END
TES 11/15/73: TEST ABOVE USED TO BE "0" LEQ L1 LEQ "9".
ALSO, TOOK OUT "PHRASE RESPONSE", VARI=0;
ELSE BEGIN VARI ← 2 ; L1 ← X ; SIG ← CVASC(X) ; CLU ← LENGTH(X) ;
DPASS ; A ← 0 ;
WHILE ¬(ITSCH(;) ∨ ITSCH(⊂)) DO
BEGIN
IF ¬THISISID THEN
BEGIN
WARN("=","Argument must be identifier.") ;
ROTTEN←TRUE ;
END ;
S←SYMB ; PASS ; IF LENGTH(X←SIMPAR)≠1 THEN WARN("=","Separator 1 character only");
PUTI(1, S) ; A ← A LSH 7 LOR X ; DPASS ;
END ;
ARGS ← IHIGH - SIHIGH ;
END ;
END ;
END "AT"
ELSE BEGIN
PASS ; IF ¬THISISID THEN BEGIN WARN("=","BEFORE/AFTER need area/unit name") ; ROTTEN←TRUE END
ELSE BEGIN VARI←IF COMDWD THEN 3 ELSE 4; CLU←SYMB; TYP←THISTYPE; XIX←IX; PASS END ;
END ;
BOD ← DEFN(FALSE, FALSE,ARGS,SIHIGH) ; OLDIX ← RIX ← -1 ;
IF ROTTEN ∨ ¬ON THEN BEGIN IHIGH ← SIHIGH ; RETURN END ;
X ← BOD ; SCAN(X, TO!NON!SP, HASBODY) ; IF ¬HASBODY THEN BOD ← NULL ;
CASE VARI-1 MIN 2 OF
BEGIN
ie 0... Phrase TES 11/15/73 removed this case ;
ie 1 ... Inset ;IF FINDINSET(CLU) THEN
IF DEPTH!RESP(LLTHIS) < DEPTH THEN
BEGIN
RESPREPL ;
IF LLPREV<0 THEN LEADRESPS←RIX ELSE NEXT!RESP(LLPREV) ← RIX ;
END
ELSE IF HASBODY THEN OLDIX ← RIX ← LLTHIS TES 11/29/73 OLDIX;
ELSE BEGIN
OLDIX ← LLTHIS ; TES 11/29/73 ;
LLSKIP(LEADRESPS, NEXT!RESP)
END
ELSE BEGIN
RIX←PUSHI(RESPWDS,RESPTYPE) ;
LLINS(LEADRESPS,NEXT!RESP,RIX) ;
END ;
ie 2 ... Signal;BEGIN S ← 0 ; comment Old response of same signal: >0 for outer block, <0 same block;
IF FINDSIGNAL(SIG) THEN
BEGIN
S ← IF DEPTH!RESP(LLTHIS) < DEPTH THEN LLTHIS ELSE -LLTHIS ;
IF S<0 THEN OLDIX ← LLTHIS; TES 11/29/73 ;
LLSKIP(SIGNALD[L1], NEXT!RESP) ; LLTHIS ← LLPOST ;
END ;
IF HASBODY ∨ S > 0 THEN
BEGIN
RIX←PUSHI(SIGWDS,RESPTYPE); SIGNAL(RIX)←SIG ; NUMARGS(RIX) ← ARGS ;
LLINS(SIGNALD[L1], NEXT!RESP, RIX) ; RESP!SEP(RIX) ← A ;
IF S = 0 THEN SIG!BRC ← (SIG LSH -29) & SIG!BRC ; OLD!RESP(RIX) ← S MAX 0;
END ;
IF NULSTR(BOD) ∧ S THEN
BEGIN
X ← NULL ;
WHILE FULSTR(SIG!BRC) ∧ (A ← LOP(SIG!BRC)) ≠ L1 DO X ← X & A ;
SIG!BRC ← X & SIG!BRC ;
END ;
SETBREAK(TEXT!TBL, TEXT!BRC&SIG!BRC, NULL, "IS") ;
END ;
ie 3,4... AFTER/BEFORE area|unit ;
IF FINDTRAN(CLU, VARI) THEN
IF DEPTH!RESP(LLTHIS) < DEPTH THEN
BEGIN
RESPREPL ;
IF LLPREV < 0 THEN WAITRESP←RIX ELSE NEXT!RESP(LLPREV) ← RIX ;
END
ELSE IF HASBODY THEN OLDIX ← RIX ← LLTHIS
ELSE BEGIN
OLDIX ← LLTHIS ; TES 11/29/73 ;
LLSKIP(WAITRESP, NEXT!RESP)
END
ELSE BEGIN
RIX←PUSHI(RESPWDS,RESPTYPE) ;
LLINS(WAITRESP,NEXT!RESP,RIX) ;
END ;
END ;
IF OLDIX GEQ 0 THEN SSTK[BODY(OLDIX)] ← NULL ; TES 11/29/73 GC ;
IF RIX ≥ 0 THEN
BEGIN
CLUE(RIX) ← CLU ; VARIETY(RIX) ← VARI ;
BODY(RIX) ← PUSHS(1,BOD) ; DEPTH!RESP(RIX) ← DEPTH ;
END ;
END "DRESPONSE" ;
SIMPLE PROCEDURE DREQUIRE ;
BEGIN
STRING F ;
PASS ; F ← E(NULL, "SOURCE!FILE") ;
IF ¬EQU(THISWD[1 TO 6],"SOURCE") THEN WARN("=","REQUIRE -- SOURCE!FILE only!") ;
IF FULSTR(F) ∧ ON THEN SWICHF(F) ; PASS ;
END "DREQUIRE" ;
SIMPLE PROCEDURE DSEND ;
BEGIN
INTEGER PIX; STRING FI ;
INTEGER SIMPLE PROCEDURE OPORT ;
BEGIN INTEGER CH ; CH←WRITEON(FALSE,
IFC TENEX THENC IFILENAME&GENEXT&(FI←THISWD) ELSEC
(FI←(CVS(PORTS←PORTS+1)&THISWD)[1 TO 5])&PUGEXT ENDC) ;
RETURN(CH) ; END "OPORT" ;
PASS ; IF ¬THISISID THEN BEGIN WARN("=","SEND Where?") ; RETURN END ;
IF ¬ON THEN BEGIN PASS ; DEFN(FALSE, FALSE,0,0) ; RETURN END ;
IF THISTYPE ≠ PORTYPE THEN
BEGIN
BIND(SYMB←DECLARE(SYMB, PORTYPE), PIX ← PUTI(4, OPORT) ) ;
PORSTR(PIX) ← PUTS(NULL) ; PUTS(NULL) ;
PORSEQ(PIX) ← 0 ; PORFIL("PORSTR(PIX)") ← FI ;
END
ELSE IF PORCH(PIX←IX)=-5 THEN
BEGIN PORCH(PIX)←OPORT ; PORFIL("PORSTR(PIX)")←FI END ;
PASS ;
SEND(PIX, DEFN(TRUE,PORCH(PIX)≠-1,0,0)) ;
END "DSEND" ;
SIMPLE PROCEDURE DSHOW ;
BEGIN
END "DSHOW" ;
SIMPLE PROCEDURE DSUPERIMPOSE ;
BEGIN
INTEGER N ;
DBREAK ; PASS ; N ← CVD(E("0",NULL)) MIN 50 ;IF N<1 THEN N←50 ; IF ¬ON THEN RETURN ;
TWEENLFM ← N-1; SINCELFM ← 0; BREAKM ← 5;
END "DSUPERIMPOSE" ;
RECURSIVE PROCEDURE DSKIP(BOOLEAN GRPSKIP) ;
BEGIN
BOOLEAN GM ;
DBREAK ; PASS ;
IF GRPSKIP THEN BEGIN GM←GROUPM ; GROUPM ←1 ; END ;
IF ITS(TO) THEN
BEGIN "SKIP TO"
DAPART ; PASS ;
IF ITS(COLUMN) THEN BEGIN PASS; TOCOLUMN(CVD(E(CVS(COL+1),NULL))) END
ELSE BEGIN IF ITS(LINE) THEN PASS ; TOLINE(CVD(E("1", NULL))) END ;
END "SKIP TO"
ELSE SKIPLINES(IF THISTYPE>INTERNTYPE ∨ THISTYPE=-TERQ ∨ NEXTSCH(←) ∨ NEXTSCH(:)
THEN 1 ELSE CVD(E("1", NULL))) ;
IF GRPSKIP ∧ GM = 0 THEN DAPART ;
END "DSKIP" ;
SIMPLE PROCEDURE DTABS ;
BEGIN
INTEGER NUMB, I ; BOOLEAN TOO ;
IF ON THEN TABSORT[1] ← TWO(33) ; TOO ← FALSE ;
DO BEGIN
PASS ; NUMB ← CVD(E("-9999", NULL)) MIN 9999 ;
IF ON THEN
BEGIN
FOR I ← 1 THRU 27 DO IF TABSORT[I] ≥ NUMB THEN DONE ; IF I>27 THEN TOO←TRUE;
IF ¬TOO ∧ NUMB > -9999 THEN
IF TABSORT[I] > NUMB THEN DO BEGIN TABSORT[I] ↔ NUMB ; I ← I + 1 END UNTIL TABSORT[I-1]=TWO(33) ;
END ;
END
UNTIL ¬ITSCH(",") ;
IF TOO THEN WARN("=","Too many Tab Stops") ;
END "DTABS" ;
SIMPLE PROCEDURE DTURN(BOOLEAN TURNON) ;
BEGIN
comment TURN ON|OFF {"c" [FOR "c"]},... ;
INTEGER C1, C2 ; STRING S1, S2 ;
PASS ;
IF THISTYPE>INTERNTYPE ∨ THISTYPE=-TERQ ∨ NEXTSCH(:) ∨ NEXTSCH(←) THEN
BEGIN "TURN BACK"
C1 ← IHED ;
WHILE C1>0 ∧ (C2←IXTYPE(C1))≠MODETYPE ∧ (C2≠TURNTYPE ∨ ISTK[C1-1]<0) DO C1 ← IXOLD(C1) ;
IF C2=TURNTYPE THEN DO BEGIN TURN((C2←ISTK[C1-1]) LSH -7,C2 LAND '177,1) ;
ISTK[C1-1] ← -2 ; C1 ← IXOLD(C1) END UNTIL C1≤0 ∨ IXTYPE(C1)≠TURNTYPE ∨ ISTK[C1-1]<0 ;
END "TURN BACK"
ELSE BEGIN "TURN CHARS"
PUSHI(TURNWDS, TURNTYPE) ; ISTK[IHED-1] ← -1 ;
DO BEGIN
IF ITSCH(",") THEN PASS ;
S1 ← IF NOT ITS(TAB) THEN SIMPAR ELSE TB ; PASS ;
COMMENT 2/27/73 TES ;
IF ITS(FOR) THEN BEGIN PASS ; S2 ← SIMPAR ; PASS END ELSE IF TURNON THEN S2 ← S1 ELSE S2 ← NULL ;
IF ON THEN
BEGIN
IF 0 ≠ LENGTH(S2) ≠ LENGTH(S1) THEN
WARN(NULL,"Strings each side of FOR are unequal length") ;
WHILE FULSTR(S1) DO
TURN(LOP(S1), IF FULSTR(S2) THEN LOP(S2) ELSE 0, TURNON) ;
END ;
END UNTIL ¬ITSCH(",") ;
END "TURN CHARS" ;
END "DTURN" ;
SIMPLE PROCEDURE DUSERERR ; RKJ: 1-9-74;
BEGIN "DUSERERR"
STRING USER!MESSAGE;
PASS;
USER!MESSAGE ← E(NULL,NULL);
IF ON THEN WARN("=",USER!MESSAGE);
END "DUSERERR";
INTEGER SIMPLE PROCEDURE COUNTERSTMT ;
IF ITS(NEXT) THEN
BEGIN
INTEGER USYMB ; ie, unit name symbol number ;
PASS ; USYMB←IF THISTYPE=UNITTYPE THEN SYMB ELSE IF THISTYPE=PUNITTYPE THEN -SYMB ELSE TWO(20) ;
DNEXT ; RETURN(USYMB) ;
END
ELSE RETURN(0) ;
BOOLEAN SIMPLE PROCEDURE LABELDEF ;
IF ¬NEXTSCH(:) THEN RETURN(FALSE)
ELSE IF ¬ON THEN
BEGIN
WHILE THISISID ∧ NEXTSCH(:) DO BEGIN PASS ; PASS END ;
IF ¬ COUNTERSTMT THEN E(0, 0) ; RETURN(TRUE) ;
END
ELSE
BEGIN
INTEGER LINK, PTR, PLIGHT, USYMB, WASSYMB, VALPTR ; STRING DEFVAL ;
SIMPLE PROCEDURE CHECK!CONSISTENCY ;
IF WASSYMB ∧ USYMB≠0 ∧ LDB(IXN(WASSYMB)) ≠ LDB(IXN(ABS(USYMB))) THEN
WARN("=","Label "&SYM[LINK]&" was cross-referenced as a "&
SYM[WASSYMB]&" but is being defined as a "&
SYM[ABS(USYMB)]) ;
LINK ← 0 ;
DO BEGIN "MULTIPLE LABELS"
PTR ← SYMNUM(THISWD&":") ; BYTEWD ← NUMBER[PTR] ;
IF BYTEWD=0 OR ( PLIGHT ← LDB(PLIGHTWD(BYTEWD)) ) = 1 THEN
BEGIN NUMBER[PTR] ← BYTEWD LSH 13 LOR LINK ; LINK ← PTR END
ELSE WARN("=","Label "&SYM[PTR]&" is already defined as "&
(IF PLIGHT=2 THEN STBL[IX] ELSE "a recent page number")) ;
PASS ; PASS ;
END "MULTIPLE LABELS"
UNTIL ¬(THISISID ∧ NEXTSCH(:)) ;
IF LINK = 0 THEN RETURN(TRUE) ; TES 11/29/73 ;
DEFVAL ← IF (USYMB←COUNTERSTMT)=0 THEN E(0,0)
ELSE IF USYMB>TWO(13) THEN "??"
ELSE IF USYMB>0 THEN C! ELSE !;
IF EQU(DEFVAL,0) OR USYMB = SYMPAGE THEN
DO BEGIN "PAGE LABELS"
NUMBER[LINK] ↔ PLBL ; WASSYMB ← PLBL LSH -13 ;
CHECK!CONSISTENCY ;
PLBL ↔ LINK ; LINK ← LINK LAND '17777 ; PLBL ← -PLBL ;
END "PAGE LABELS"
UNTIL LINK=0
ELSE BEGIN "OTHER UNIT"
VALPTR ← 2 ROT -2 LOR PUTS(DEFVAL&(IF XCRIBL THEN ALTMODE&CVS(XLENGTH(DEFVAL)) ELSE NULL)) ;
DO BEGIN
PTR ← VALPTR ; NUMBER[LINK] ↔ PTR ; WASSYMB ← PTR LSH -13 ;
CHECK!CONSISTENCY ;
LINK ← PTR LAND '17777 ;
END
UNTIL LINK=0 ;
END "OTHER UNIT" ;
RETURN(TRUE) ;
END "LABELDEF" ;
RECURSIVE BOOLEAN PROCEDURE ASSIGNMENT ;
IF NEXTSCH(←) THEN
BEGIN
VASSIGN(SYMB, THISTYPE, IX, E(SPASS(PASS), 0)) ;
IF ITSCH(;) THEN PASS ; RETURN(TRUE) ;
END
ELSE RETURN(FALSE) ;
BOOLEAN SIMPLE PROCEDURE EMPTYCHUNK ;
RETURN(IF ITSCH(;) THEN IPASS(TRUE) ELSE FALSE) ;
BOOLEAN SIMPLE PROCEDURE NONSENSE(BOOLEAN VALID) ;
BEGIN
IF VALID THEN WARN("=","Can't make sense out of: "&SOMEINPUT) ;
PASS ; RETURN(FALSE) ;
END "NONSENSE" ;
RECURSIVE BOOLEAN PROCEDURE COMMAND ;
BEGIN
DEFINE DB(WHAT) = "BEGIN IF ON THEN WHAT; PASS END",
BDB(WHAT)="BEGIN IF ON THEN BEGIN DBREAK; WHAT END; PASS END";
IF THATISID ∧ SYMLOOK(THISWD&THATWD) ∧ LDB(TYPEN(SYMBOL))=MANTYPE THEN
BEGIN THISWD ← SYM[SYMB←SYMBOL] ; THISTYPE ← MANTYPE ;
IX ← LDB(IXN(SYMB)) ; RDENTITY ; END
ELSE IF THISTYPE ≠ MANTYPE THEN RETURN(FALSE) ;
CASE IX OF
BEGIN COMMENT COMMANDS ; comment THISWD is command word.;
ie ADJUST ; BDB(JUSTM←1) ;
ie AFTER ; DRESPONSE(2) ;
ie APART ; BEGIN DAPART ; PASS END ;
ie AREA ; DAREA(FALSE) ;
ie AT ; DRESPONSE(1) ;
ie BEFORE ; DRESPONSE(0) ;
ie BEGIN ; BEGIN BEGINBLOCK(FALSE, IF ENDCASE=2 ∧ ON THEN -1 ELSE 1,
IF THATISCON THEN SPASS(THATWD[2 TO ∞]) ELSE NULL) ; PASS END ;
ie BELOW ; DBELOW ;
ie BLANK PAGE ; DBLANKPAGE ;
ie BOX FRAME ; DFRAME(TRUE) ;
ie BREAK ; BEGIN DBREAK ; PASS END ;
ie BURP ; DBURP ; TES 8/19/74 BURP OUT STATE INFO ;
ie CENTER ; BDB(BREAKM←4) ;
ie CLOSE ; DCLOSE ;
ie COMMAND CHARACTER ; DCOMMANDCHARACTER ;
ie COMMENT ; BEGIN IMPOSSIBLE("COMMAND") ; PASS END ;
ie COMPACT ; DB(SPACEM←IF FILL THEN 1 ELSE 2) ;
ie CONTINUE ; BDB(NOPGPH ← 1) ;
ie COUNT ; DCOUNT ;
ie CRBREAK ; DB(CRBM←1) ;
ie CRSPACE ; DB(CRBM←0) ;
ie DDT ; BEGIN ERROR(0, "DDT", "D") ; PASS END ;
ie DEVICE ; DDEVICE ;
ie DONE ; DDONE(FALSE) ; TES 8/14/74 AND 8/19/74 ;
ie END ; CASE IF STARTS THEN 0 ELSE ENDCASE OF BEGIN STARTEND; BEGINEND; ONCEEND; RESPEND END ;
ie FILL ; BDB(BREAKM ← 0 ; SPACEM ← SPACEM MIN 1) ;
ie FLUSH LEFT ; BDB(BREAKM←2) ;
ie FLUSH RIGHT ; BDB(BREAKM←3) ;
ie FONT ; DFONT(FALSE);
ie GROUP ; IF GROUPM THEN PASS ELSE BDB(GROUPM←1) ;
ie GROUP SKIP ; DSKIP(TRUE) ;
ie IF ; DCONDITIONAL ;
ie INDENT ; DINDENT ;
ie INSERT ; DINSERT ;
ie JUSTJUST ; BDB(BREAKM←1) ;
ie LET ; DLET ;
ie LOCK ; DLOCK ;
ie MACRO ; DMACRO(1) ;
ie NARROW ; DMARGINS(1) ; COMMENT SEMI-OBSOLETE ;
ie NEXT ; BEGIN PASS ; DNEXT END ;
ie NOFILL ; BDB(BREAKM←7) ;
ie NOJUST ; BDB(JUSTM←0) ;
ie ONCE ; BEGIN IF ON∧ENDCASE≠2 THEN BEGIN INTEGER S ; S ← STARTS ; STARTS ← 0 ;
BEGINBLOCK(FALSE,2,ALTMODE) ; STARTS ← S ; END ; PASS END ;
ie PACK ; DPACK ;
ie PAGE FRAME ; DFRAME(FALSE) ;
ie PICHAR ; DPICHAR ;
ie PLACE ; BEGIN IF ON THEN DBREAK ; PASS ; PLACE(IX) ; PASS END ;
ie PORTION ; DPORTION ;
ie PREFACE ; BEGIN DBREAK; PASS; K←CVD(E("0",NULL)); IF ON THEN IF FILL THEN LEADFM←K ELSE LEADNM←K END ;
ie PROCEDURE ; DMACRO(2) ; TES 8/19/74 ;
ie PUB!DEBUG ; DPUB!DEBUG ; TES 8/21/74 ;
ie RECEIVE ; DRECEIVE ;
ie RECURSIVE MACRO ; DMACRO(0) ;
ie REPEAT ; DREPEAT ;
ie REQUIRE ; DREQUIRE ;
ie RETAIN ; DB(SPACEM←0) ;
ie RETURN ; DDONE(TRUE) ; TES 8/19/74 ;
ie SELECT ; DFONT(TRUE) ;
ie SEND ; DSEND ;
ie SHOW ; DSHOW ;
ie SKIP ; DSKIP(FALSE) ;
ie START ; BEGIN BEGINBLOCK(FALSE,0,IF THATISCON THEN SPASS(THATWD[2 TO ∞]) ELSE NULL) ; PASS END;
ie SUPERIMPOSE ; DSUPERIMPOSE ;
ie TABS ; DTABS ;
ie TEXT AREA ; DAREA(FALSE) ;
ie TITLE AREA ; DAREA(TRUE) ;
ie TURN OFF ; DTURN(0) ;
ie TURN ON ; DTURN(-1) ;
ie USERERR ; DUSERERR ; RKJ: 1-9-74;
ie VARIABLE ; DLOCAL ;
ie VERBATIM ; BDB(BREAKM←6) ;
ie WIDEN ; DMARGINS(-1) ; COMMENT SEMI-OBSOLETE ;
END ; COMMENT COMMANDS ;
IF ITSCH(;) THEN PASS ;
RETURN(TRUE) ;
END ;
INTERNAL RECURSIVE BOOLEAN PROCEDURE CHUNK(BOOLEAN VALID) ;
BEGIN
IF PAGEMARKS > PAGEWAS THEN
BEGIN comment, might be AT PAGEMARK response ;
FOR PAGEWAS ← PAGEWAS + 1 THRU PAGEMARKS DO IF SIGNALD[FF] THEN RESPOND(SIGNALD[FF]) ;
PAGEWAS ← PAGEMARKS ;
END ;
RETURN(THISISID AND (ASSIGNMENT OR LABELDEF OR COMMAND OR PROCSTATEMENT)
OR TEXTLINE OR EMPTYCHUNK OR NONSENSE(VALID)) ;
TES ADDED PROCSTATEMENT 8/20/74 ;
END "CHUNK" ;
INTERNAL SIMPLE PROCEDURE MANUSCRIPT ;
BEGIN
BOOLEAN VALID ;
VALID ← TRUE ;
DO VALID ← CHUNK(VALID) UNTIL LAST < 1 ;
IF ¬NEXTS(7!MANUSCRIPT) THEN WARN("=","Brackets don't pair up!!!!!!!!!") ;
FINPORTION ; IF BLNMS=0 THEN BEGINEND ELSE IF BLNMS>0 THEN
WARN("=",CVS(BLNMS) & " Extra BEGINs and STARTs") ;
END "MANUSCRIPT" ;
END "INNER BLOCK" ;
END "PARSER"